From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Tue, 17 Feb 2009 06:50:16 +0000 (+0100)
Subject: Better diagnostics for the ~~ test
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9e079acef3281a4f29fb1913eeef734bf70ba393;p=p5sagit%2Fp5-mst-13.2.git

Better diagnostics for the ~~ test

Read from DATA line per line, so warnings are reported from the correct
line. Make test names and error reports more readable.
---

diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t
index d4935dc..cf06a44 100644
--- a/t/op/smartmatch.t
+++ b/t/op/smartmatch.t
@@ -37,11 +37,12 @@ our $ov_obj = Test::Object::CopyOverload->new;
 our $obj = Test::Object::NoOverload->new;
 
 # Load and run the tests
-my @tests = map [chomp and split /\t+/, $_, 3], grep !/^#/ && /\S/, <DATA>;
-plan tests => 2 * @tests;
+plan "no_plan";
 
-for my $test (@tests) {
-    my ($yn, $left, $right) = @$test;
+while (<DATA>) {
+    next if /^#/ || !/\S/;
+    chomp;
+    my ($yn, $left, $right) = split /\t+/;
 
     match_test($yn, $left, $right);
     match_test($yn, $right, $left);
@@ -52,21 +53,23 @@ sub match_test {
 
     die "Bad test spec: ($yn, $left, $right)"
 	unless $yn eq "" || $yn eq "!" || $yn eq '@';
-    
+
     my $tstr = "$left ~~ $right";
-    
-    my $res;
-    $res = eval $tstr // "";	#/ <- fix syntax colouring
+
+    my $res = eval $tstr;
 
     chomp $@;
 
     if ( $yn eq '@' ) {
-	ok( $@ ne '', sprintf "%s%s: %s", $tstr, $@ ? ( ', $@', $@ ) : ( '', $res ) );
+	ok( $@ ne '', "$tstr dies" )
+	    and print "# \$\@ was: $@\n";
     } else {
+	my $test_name = $tstr . ($yn eq '!' ? " does not match" : " matches");
 	if ( $@ ne '' ) {
-	    fail("$tstr, \$\@: $@");
+	    fail($test_name);
+	    print "# \$\@ was: $@\n";
 	} else {
-	    ok( ($yn eq '!' xor $res), "$tstr: $res");
+	    ok( ($yn eq '!' xor $res), $test_name );
 	}
     }
 }