diff options
author | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2009-02-17 07:50:16 +0100 |
---|---|---|
committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2009-02-20 09:30:38 +0100 |
commit | 9e079acef3281a4f29fb1913eeef734bf70ba393 (patch) | |
tree | b5344a6aac41bb6b736710e7270737aeb7b9803b /t/op | |
parent | 5c9c28c6793ca919087c2d34fbac700aa9375ff7 (diff) | |
download | perl-9e079acef3281a4f29fb1913eeef734bf70ba393.tar.gz |
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.
Diffstat (limited to 't/op')
-rw-r--r-- | t/op/smartmatch.t | 25 |
1 files changed, 14 insertions, 11 deletions
diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t index d4935dc163..cf06a4468f 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 ); } } } |