Add tests for last and next in when()

[p5sagit/p5-mst-13.2.git] / t / op / smartmatch.t

diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t
index d4935dc..fcacd76 100644 (file)
--- a/t/op/smartmatch.t
+++ b/t/op/smartmatch.t
@@ -36,13 +36,20 @@ tie my %tied_hash, 'Tie::StdHash';
 our $ov_obj = Test::Object::CopyOverload->new;
 our $obj = Test::Object::NoOverload->new;
 
+my @keyandmore = qw(key and more);
+my @fooormore = qw(foo or more);
+my %keyandmore = map { $_ => 0 } @keyandmore;
+my %fooormore = map { $_ => 0 } @fooormore;
+
 # 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, $note) = split /\t+/;
 
+    local $::TODO = $note =~ /TODO/;
     match_test($yn, $left, $right);
     match_test($yn, $right, $left);
 }
@@ -52,21 +59,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 );
        }
     }
 }
@@ -74,8 +83,8 @@ sub match_test {
 
 
 sub foo {}
-sub bar {2}
-sub gorch {2}
+sub bar {42}
+sub gorch {42}
 sub fatal {die "fatal sub\n"}
 
 sub a_const() {die "const\n" if @_; "a constant"}
@@ -88,24 +97,55 @@ sub TWO() { 1 }
 #   - expected to match
 # ! - expected to not match
 # @ - expected to be a compilation failure
+# Data types to test :
+#   Object-overloaded
+#   Object
+#   Code
+#   Code()
+#   Coderef
+#   Hash
+#   Hashref
+#   Array
+#   Arrayref
+#   Regex (// and qr//)
+#   Num
+#   Str
+#   undef
 __DATA__
 # OBJECT
 # - overloaded
        $ov_obj         "key"
-       $ov_obj         {"key" => 1}
 !      $ov_obj         "foo"
+       $ov_obj         {"key" => 1}
+       $ov_obj         {"key" => 1, bar => 2}          TODO
+!      $ov_obj         {"foo" => 1}
+       $ov_obj         ["key" => 1]
+!      $ov_obj         ["foo" => 1]
+       $ov_obj         @keyandmore
+!      $ov_obj         @fooormore
+       $ov_obj         %keyandmore                     TODO
+!      $ov_obj         %fooormore
+       $ov_obj         /key/
+!      $ov_obj         /foo/
+       $ov_obj         qr/Key/i
+!      $ov_obj         qr/foo/
        $ov_obj         sub { shift ~~ "key" }
+!      $ov_obj         sub { shift eq "key" }
 !      $ov_obj         sub { shift ~~ "foo" }
 !      $ov_obj         \&foo
+       $ov_obj         \&bar
 @      $ov_obj         \&fatal
 !      $ov_obj         FALSE
 !      $ov_obj         \&FALSE
 !      $ov_obj         undef
+       $ov_obj         $ov_obj
 
 # regular object
 @      $obj    "key"
 @      $obj    {"key" => 1}
-@      $obj    $obj
+@      $obj    ["key" => 1]
+@      $obj    /key/
+@      $obj    qr/key/
 @      $obj    sub { 1 }
 @      $obj    sub { 0 }
 @      $obj    \&foo
@@ -113,6 +153,7 @@ __DATA__
 @      $obj    FALSE
 @      $obj    \&FALSE
 !      $obj    undef
+@      $obj    $obj
 
 # CODE ref against argument
 #  - arg is code ref
@@ -143,8 +184,11 @@ __DATA__
 @      []      \&fatal
 @      "foo"   \&fatal
 @      qr//    \&fatal
-@      $obj    \&bar
-       $ov_obj \&bar
+# pass argument by reference
+       @fooormore      sub{scalar @_ == 1}
+       @fooormore      sub{"@_" =~ /ARRAY/}
+       %fooormore      sub{"@_" =~ /HASH/}
+       /fooormore/     sub{ref $_[0] eq 'Regexp'}
 
 # - null-prototyped subs
        a_const         "a constant"
@@ -198,7 +242,7 @@ __DATA__
 
 #  - a regex
        {foo => 1}      qr/^(fo[ox])$/
-!      +{0..100}       qr/[13579]$/
+!      +{0..99}        qr/[13579]$/
 
 #  - a string
        +{foo => 1, bar => 2}   "foo"
@@ -264,7 +308,8 @@ __DATA__
        %hash           [qw(bar)]
 !      %hash           [qw(a b c)]
        %hash           %hash
-       %hash           {%hash}
+       %hash           +{%hash}
+       %hash           \%hash
        %hash           %tied_hash
        %tied_hash      %tied_hash
        %hash           { foo => 5, bar => 10 }