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 65bd079..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,42 +83,83 @@ 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"}
 sub b_const() {die "const\n" if @_; "a constant"}
+sub FALSE() { 0 }
+sub TRUE() { 1 }
+sub TWO() { 1 }
 
 # Prefix character :
 #   - 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    "foo"
-@      $obj    $obj
+@      $obj    ["key" => 1]
+@      $obj    /key/
+@      $obj    qr/key/
 @      $obj    sub { 1 }
 @      $obj    sub { 0 }
 @      $obj    \&foo
 @      $obj    \&fatal
+@      $obj    FALSE
+@      $obj    \&FALSE
 !      $obj    undef
+@      $obj    $obj
 
 # CODE ref against argument
 #  - arg is code ref
        \&foo           \&foo
 !      \&foo           sub {}
+!      \&foo           sub { "$_[0]" =~ /^CODE/ }
 !      \&foo           \&bar
        \&fatal         \&fatal
 !      \&foo           \&fatal
@@ -119,6 +169,7 @@ __DATA__
 !      0       sub{shift}
 !      undef   sub{shift}
        undef   sub{not shift}
+       FALSE   sub{not shift}
        1       sub{scalar @_}
        []      \&bar
        {}      \&bar
@@ -133,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"
@@ -142,6 +196,20 @@ __DATA__
        a_const         b_const
        \&a_const       \&a_const
 !      \&a_const       \&b_const
+!      undef           \&FALSE
+       undef           \&TRUE
+!      0               \&FALSE
+       0               \&TRUE
+!      1               \&FALSE
+       1               \&TRUE
+       \&FALSE         \&FALSE
+!      \&FALSE         \&foo
+!      \&FALSE         \&bar
+!      \&TRUE          \&foo
+!      \&TRUE          \&bar
+!      \&TWO           \&foo
+!      \&TWO           \&bar
+       \&FALSE         \&FALSE
 
 # - non-null-prototyped subs
 !      \&bar           \&gorch
@@ -174,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"
@@ -210,12 +278,15 @@ __DATA__
 # Number against number
        2               2
 !      2               3
+       0               FALSE
+       3-2             TRUE
 
 # Number against string
        2               "2"
        2               "2.0"
 !      2               "2bananas"
 !      2_3             "2_3"
+       FALSE           "0"
 
 # Regex against string
        qr/x/           "x"
@@ -237,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 }