Add lib/dg.exp unit tests for skipping files by callback

2 files changed, 41 insertions, 1 deletions

diff --git a/ChangeLog b/ChangeLog
index 287ae43..04d1aa0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2022-10-04  Jacob Bachmeyer  <jcb@gnu.org>
+
+	PR58065
+
+	* testsuite/runtest.libs/dg.test: Add tests for skipping tests
+	based on special result codes from mock-dg-prune.
+	(mock-dg-test): Add directive for output text.
+	(mock-dg-prune): Recognize special markers for
+	UNRESOLVED/UNSUPPORTED/UNTESTED result codes.
+
 2022-10-01  Jacob Bachmeyer  <jcb@gnu.org>
 
 	PR58065
diff --git a/testsuite/runtest.libs/dg.test b/testsuite/runtest.libs/dg.test
index c9fff87..bdfc0b1 100644
--- a/testsuite/runtest.libs/dg.test
+++ b/testsuite/runtest.libs/dg.test
@@ -44,10 +44,11 @@ proc mock-dg-test { prog what flags } {
 
     while { [gets $chan line] >= 0 } {
 	incr linum
-	if { [regexp -- {^%([EW])\s+([^\r\n{}]*)} $line -> item text] } {
+	if { [regexp -- {^%([EWO])\s+([^\r\n{}]*)} $line -> item text] } {
 	    switch -- $item {
 		E { append output "$prog:$linum: error: $text\n" }
 		W { append output "$prog:$linum: warning: $text\n" }
+		O { append output "$text\n" }
 	    }
 	}
     }
@@ -62,6 +63,10 @@ proc mock-dg-prune { target output } {
     puts "target: $target"
     puts "output:\n$output"
     puts ">>> output pruning callback"
+    if { [regexp -- {--(unresolved|unsupported|untested): (.*)--} $output \
+	      -> what why] } {
+	return "::${what}::${why}"
+    }
     return $output
 }
 
@@ -168,6 +173,11 @@ create_mock_file dg-test-vfs \
 	#E bogus error
     }
 
+foreach {result} { unresolved unsupported untested } {
+    create_mock_file dg-test-vfs "dg/pskip-${result}" \
+	"#test file for dg.exp\n%O --${result}: skip by prune--\n"
+}
+
 dg-test-1 eval {proc send_log { text } { puts $text }}
 
 dg-test-1 eval dg-init
@@ -251,6 +261,26 @@ eval_tests dg-test-1 {
 	}
     }
 }
+foreach {result} { unresolved unsupported untested } {
+    set check_calls {
+	pass ! {} fail ! {} xpass ! {} xfail ! {} kpass ! {} kfail ! {}
+    }
+    switch -- $result {
+	unresolved {
+	    lappend check_calls unresolved C 1 unsupported ! {} untested ! {}
+	}
+	unsupported {
+	    lappend check_calls unresolved ! {} unsupported C 1 untested ! {}
+	}
+	untested {
+	    lappend check_calls unresolved ! {} unsupported ! {} untested C 1
+	}
+    }
+    lappend check_calls $result 0 { 1 {.*skip by prune.*} }
+    test_proc_with_mocks "test with dg/pskip-${result}" dg-test-1 \
+	[list dg-runtest dg/pskip-${result} "" ""] \
+	check_calls $check_calls
+}
 dg-test-1 eval dg-finish