Add testsuite support for building tarballs for test cases
authorJacob Bachmeyer <jcb@gnu.org>
Fri, 30 Apr 2021 23:49:40 +0000 (18:49 -0500)
committerJacob Bachmeyer <jcb@gnu.org>
Fri, 30 Apr 2021 23:49:40 +0000 (18:49 -0500)
testsuite/lib/upload.exp

index 6f270d414b0e9c8c57584b29b332fd3a9cc6e4fc..d1ef2d4febc70becc058d4aef94e542492ef8073 100644 (file)
@@ -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)
+                   }
+               }
+       }
     }
 }