From 52965c9ff8fe29852eb611b1589f8cd9f85e4959 Mon Sep 17 00:00:00 2001
From: Jacob Bachmeyer <jcb@gnu.org>
Date: Mon, 21 Nov 2022 21:56:35 -0600
Subject: [PATCH] Add tests for inbox and scratch cleanup

---
 testsuite/gatekeeper.all/00_idle.exp | 72 ++++++++++++++++++++++++++++
 testsuite/lib/gatekeeper.exp         |  6 +++
 2 files changed, 78 insertions(+)

diff --git a/testsuite/gatekeeper.all/00_idle.exp b/testsuite/gatekeeper.all/00_idle.exp
index d6223c0..c9d0e49 100644
--- a/testsuite/gatekeeper.all/00_idle.exp
+++ b/testsuite/gatekeeper.all/00_idle.exp
@@ -410,4 +410,76 @@ check_oversize_part 0 1
 
 # ----------------------------------------
 
+proc check_cleanup { which } {
+    set tenv [new_test_environment]
+
+    switch -- $which {
+	incoming	{ set other in-stage }
+	in-stage	{ set other incoming }
+    }
+
+    set test_file	[file join $tenv $which  test-old-file]
+    set backup_file	[file join $tenv $which .test-old-file]
+
+    put_file $test_file "old file 1\n"
+    age_file $test_file "3 days ago"
+
+    start_test_services $tenv
+    run_upload_batch_test
+    stop_test_services
+
+    analyze_file_tree $tenv "idle processing: cleanup $which" \
+	[list $other stage pub archive ] empty
+    analyze_file_tree $tenv "idle processing: cleanup $which" \
+	[list $which] files {
+	    .test-old-file
+	}
+
+    analyze_log $tenv "idle processing: cleanup $which" {
+	start "ftp-upload start message"
+	nowork "ftp-upload 'nothing to do' message"
+    }
+
+    if { [get_file $backup_file] eq "old file 1" } {
+	pass "idle processing: cleanup $which: backup file"
+    } else {
+	fail "idle processing: cleanup $which: backup file"
+    }
+
+    put_file $test_file "old file 2\n"
+    age_file $test_file "2 days ago"
+
+    start_test_services $tenv
+    run_upload_batch_test
+    stop_test_services
+
+    analyze_file_tree $tenv \
+	"idle processing: cleanup $which keeps one backup" \
+	[list $other stage pub archive ] empty
+    analyze_file_tree $tenv \
+	"idle processing: cleanup $which keeps one backup" \
+	[list $which] files {
+	    .test-old-file
+	}
+
+    analyze_log $tenv \
+	"idle processing: cleanup $which keeps one backup" {
+	    start "ftp-upload start message"
+	    nowork "ftp-upload 'nothing to do' message"
+	}
+
+    if { [get_file $backup_file] eq "old file 2" } {
+	pass "idle processing: cleanup $which keeps one backup: backup file"
+    } else {
+	fail "idle processing: cleanup $which keeps one backup: backup file"
+    }
+
+    close_test_environment $tenv
+}
+
+check_cleanup incoming
+check_cleanup in-stage
+
+# ----------------------------------------
+
 #EOF
diff --git a/testsuite/lib/gatekeeper.exp b/testsuite/lib/gatekeeper.exp
index b80e172..e13d542 100644
--- a/testsuite/lib/gatekeeper.exp
+++ b/testsuite/lib/gatekeeper.exp
@@ -37,6 +37,12 @@ proc gatekeeper_count_failures { args } {
 }
 set local_record_procs(fail) gatekeeper_count_failures
 
+proc get_file { file } {
+    set chan [open $file r]
+    set ret [read -nonewline $chan]
+    close $chan
+    return $ret
+}
 proc put_file { file string } {
     set chan [open $file w]
     puts -nonewline $chan $string
-- 
2.25.1