Various changes to regex diagnostics and testing

* Make ANYOF output from regprop easier to read by adding ][ in between the unicode representation and the "ascii" one

* Make it possible to make tests in re_tests todo.

* add a todo test for a complementary character class match that should fail (perl #60156)

* Also add a comment explaining a previous commit (relating to perl #60344)

p4raw-id: //depot/perl@34755

2 files changed, 15 insertions, 10 deletions

diff --git a/t/op/re_tests b/t/op/re_tests
index 6d3ef4f390..f515605acf 100644
--- a/t/op/re_tests
+++ b/t/op/re_tests
@@ -1360,4 +1360,5 @@ foo(\h)bar	foo\tbar	y	$1	\t
 /(.*?)a(?!(a+)b\2c)/	baaabaac	y	$&-$1	baa-ba
 # [perl #60344] Regex lookbehind failure after an (if)then|else in perl 5.10
 /\A(?(?=db2)db2|\D+)(?<!processed)\.csv\z/xms	sql_processed.csv	n	-	-
-/\N{U+0100}/	\x{100}	y	$&	\x{100}	# Bug #59328
\ No newline at end of file
+/\N{U+0100}/	\x{100}	y	$&	\x{100}	# Bug #59328
+[\s][\S]	\x{a0}\x{a0}	nT	-	-	# TODO Unicode complements should not match same character
\ No newline at end of file
diff --git a/t/op/regexp.t b/t/op/regexp.t
index 147e4cc622..ba5da62b65 100755
--- a/t/op/regexp.t
+++ b/t/op/regexp.t
@@ -13,6 +13,7 @@
 # 	y	expect a match
 # 	n	expect no match
 # 	c	expect an error
+#	T	the test is a TODO (can be combined with y/n/c)
 #	B	test exposes a known bug in Perl, should be skipped
 #	b	test exposes a known bug in Perl, should be skipped if noamp
 #	t	test exposes a bug with threading, TODO if qr_embed_thr
@@ -102,16 +103,19 @@ foreach (@tests) {
     my ($pat, $subject, $result, $repl, $expect, $reason) = split(/\t/,$_,6);
     $reason = '' unless defined $reason;
     my $input = join(':',$pat,$subject,$result,$repl,$expect);
-    $pat = "'$pat'" unless $pat =~ /^[:'\/]/;
+    # the double '' below keeps simple syntax highlighters from going crazy
+    $pat = "'$pat'" unless $pat =~ /^[:''\/]/; 
     $pat =~ s/(\$\{\w+\})/$1/eeg;
     $pat =~ s/\\n/\n/g;
     $subject = eval qq("$subject"); die $@ if $@;
     $expect  = eval qq("$expect"); die $@ if $@;
     $expect = $repl = '-' if $skip_amp and $input =~ /\$[&\`\']/;
-    my $todo = $qr_embed_thr && ($result =~ s/t//);
+    my $todo_qr = $qr_embed_thr && ($result =~ s/t//);
     my $skip = ($skip_amp ? ($result =~ s/B//i) : ($result =~ s/B//));
     $reason = 'skipping $&' if $reason eq  '' && $skip_amp;
     $result =~ s/B//i unless $skip;
+    my $todo= $result =~ s/T// ? " # TODO" : "";
+    
 
     for my $study ('', 'study $subject', 'utf8::upgrade($subject)',
 		   'utf8::upgrade($subject); study $subject') {
@@ -165,39 +169,39 @@ EOFCODE
 	}
 	chomp( my $err = $@ );
 	if ($result eq 'c') {
-	    if ($err !~ m!^\Q$expect!) { print "not ok $test (compile) $input => `$err'\n"; next TEST }
+	    if ($err !~ m!^\Q$expect!) { print "not ok $test$todo (compile) $input => `$err'\n"; next TEST }
 	    last;  # no need to study a syntax error
 	}
 	elsif ( $skip ) {
 	    print "ok $test # skipped", length($reason) ? " $reason" : '', "\n";
 	    next TEST;
 	}
-	elsif ( $todo ) {
+	elsif ( $todo_qr ) {
 	    print "not ok $test # TODO", length($reason) ? " - $reason" : '', "\n";
 	    next TEST;
 	}
 	elsif ($@) {
-	    print "not ok $test $input => error `$err'\n$code\n$@\n"; next TEST;
+	    print "not ok $test$todo $input => error `$err'\n$code\n$@\n"; next TEST;
 	}
 	elsif ($result =~ /^n/) {
-	    if ($match) { print "not ok $test ($study) $input => false positive\n"; next TEST }
+	    if ($match) { print "not ok $test$todo ($study) $input => false positive\n"; next TEST }
 	}
 	else {
 	    if (!$match || $got ne $expect) {
 	        eval { require Data::Dumper };
 		if ($@) {
-		    print "not ok $test ($study) $input => `$got', match=$match\n$code\n";
+		    print "not ok $test$todo ($study) $input => `$got', match=$match\n$code\n";
 		}
 		else { # better diagnostics
 		    my $s = Data::Dumper->new([$subject],['subject'])->Useqq(1)->Dump;
 		    my $g = Data::Dumper->new([$got],['got'])->Useqq(1)->Dump;
-		    print "not ok $test ($study) $input => `$got', match=$match\n$s\n$g\n$code\n";
+		    print "not ok $test$todo ($study) $input => `$got', match=$match\n$s\n$g\n$code\n";
 		}
 		next TEST;
 	    }
 	}
     }
-    print "ok $test\n";
+    print "ok $test$todo\n";
 }
 
 1;