summaryrefslogtreecommitdiff
path: root/t/op/smartmatch.t
diff options
context:
space:
mode:
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>2009-02-17 07:50:16 +0100
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>2009-02-20 09:30:38 +0100
commit9e079acef3281a4f29fb1913eeef734bf70ba393 (patch)
treeb5344a6aac41bb6b736710e7270737aeb7b9803b /t/op/smartmatch.t
parent5c9c28c6793ca919087c2d34fbac700aa9375ff7 (diff)
downloadperl-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/smartmatch.t')
-rw-r--r--t/op/smartmatch.t25
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 );
}
}
}