From 8410fe722a21d46f680af904016217761aa07f66 Mon Sep 17 00:00:00 2001
From: Jacob Bachmeyer <jcb@gnu.org>
Date: Fri, 30 Apr 2021 18:49:40 -0500
Subject: [PATCH] Add testsuite support for building tarballs for test cases

---
 testsuite/lib/upload.exp | 60 +++++++++++++++++++++++++++++++++-------
 1 file changed, 50 insertions(+), 10 deletions(-)

diff --git a/testsuite/lib/upload.exp b/testsuite/lib/upload.exp
index 6f270d4..d1ef2d4 100644
--- a/testsuite/lib/upload.exp
+++ b/testsuite/lib/upload.exp
@@ -35,7 +35,7 @@ proc age_file { file to } {
     file mtime $file [clock scan $to]
 }
 
-proc new_test_environment { stem } {
+proc new_work_area { stem } {
     set count 1
     set name "${stem}.1"
     while { [file exists $name] } {
@@ -43,6 +43,12 @@ proc new_test_environment { stem } {
 	set name "${stem}.${count}"
     }
 
+    return $name
+}
+
+proc new_test_environment { stem } {
+    set name [new_work_area $stem]
+
     global upload_failure_count
     set upload_failure_count 0
 
@@ -128,10 +134,10 @@ proc register_test_packages { base_dir packlist } {
 }
 
 # make_test_case /some/dir/some/where {
-#     some-package-name-1.2.3.tar.gz {
+#     some-package-name-1.2.3.bin {
 #	directive {
 #	    version 1.2
-#	    filename some-package-name-1.2.3.tar.gz
+#	    filename some-package-name-1.2.3.bin
 #	    ...
 #	}
 #	dsig { good|bad <sigID> <keyID>
@@ -145,7 +151,7 @@ proc register_test_packages { base_dir packlist } {
 #     other-package-name-4.5.6.tar.bz2 {
 #	directive { ... }
 #	dsig { <args for mockgpg.exp:make_test_signature> }
-#	file { ... }
+#	tar-file { README { ... } other.c { ... } }
 #	fsig { ... }
 #     }
 # }
@@ -156,6 +162,7 @@ proc make_test_case { base_dir packlist } {
 	    set "parts(${part}-mtime)" "3 minutes ago"
 	}
 	array set parts $triplet
+
 	if { [info exists parts(directive)] } {
 	    set directive {}
 	    foreach {key value} $parts(directive) {
@@ -171,12 +178,7 @@ proc make_test_case { base_dir packlist } {
 	    age_file [file join $base_dir incoming "${stem}.directive.asc"] \
 		$parts(directive-mtime)
 	}
-	if { [info exists parts(file)] } {	# write file
-	    put_file [file join $base_dir incoming "${stem}"] \
-		[string trimleft $parts(file)]
-	    age_file [file join $base_dir incoming "${stem}"] \
-		$parts(file-mtime)
-	}
+
 	if { [info exists parts(fsig)] } {	# write detached signature
 	    put_file [file join $base_dir incoming "${stem}.sig"] \
 		[sign_test_file $stem \
@@ -184,6 +186,44 @@ proc make_test_case { base_dir packlist } {
 	    age_file [file join $base_dir incoming "${stem}.sig"] \
 		$parts(fsig-mtime)
 	}
+
+	if { [info exists parts(file)] } {	# write file
+	    put_file [file join $base_dir incoming "${stem}"] \
+		[string trimleft $parts(file)]
+	    age_file [file join $base_dir incoming "${stem}"] \
+		$parts(file-mtime)
+	}
+
+	if { [info exists parts(tar-file)] } {	# build tarball
+	    if { ! [regexp {[.]tar(?:[.]|$)} $stem] } {
+		error "${stem} is not a valid tarball name"
+	    }
+	    regexp -indices {[.]tar(?:[.]|$)} $stem metastem_offsets
+	    set metastem [string range $stem \
+			      0 [expr {[lindex $metastem_offsets 0] - 1}]]
+	    set tar_file [file join $base_dir incoming "${metastem}.tar"]
+	    set tar_base [new_work_area [file join $base_dir tarpad]]
+	    file mkdir [file join $tar_base $metastem]
+	    foreach { name contents } $parts(tar-file) {
+		put_file [file join $tar_base $metastem $name] $contents
+		age_file [file join $tar_base $metastem $name] "1 hour ago"
+	    }
+	    exec tar cf $tar_file -C $tar_base $metastem
+	    age_file $tar_file $parts(file-mtime)
+	    file delete -force -- $tar_base
+	    switch -- [string range $stem \
+			   [expr {[lindex $metastem_offsets 1] + 1}] end] \
+		{
+		    gz	{
+			exec gzip  -9  $tar_file
+			age_file "${tar_file}.gz"  $parts(file-mtime)
+		    }
+		    bz2 {
+			exec bzip2 -9z $tar_file
+			age_file "${tar_file}.bz2" $parts(file-mtime)
+		    }
+		}
+	}
     }
 }
 
-- 
2.25.1