Fix test for overload in given() with smart match after last change
[p5sagit/p5-mst-13.2.git] / t / op / smartmatch.t
index ab36cbf..8c48768 100644 (file)
@@ -6,9 +6,12 @@ BEGIN {
     require './test.pl';
 }
 use strict;
+use warnings;
+no warnings 'uninitialized';
 
 use Tie::Array;
 use Tie::Hash;
+use Tie::RefHash;
 
 # Predeclare vars used in the tests:
 my @empty;
@@ -34,7 +37,15 @@ tie my %tied_hash, 'Tie::StdHash';
 {
     package Test::Object::WithOverload;
     sub new { bless { key => 'magic' } }
-    use overload '~~' => sub { my %hash = %{ $_[0] }; $_[1] eq $hash{key} };
+    use overload '~~' => sub {
+       my %hash = %{ $_[0] };
+       if ($_[2]) { # arguments reversed ?
+           return $_[1] eq reverse $hash{key};
+       }
+       else {
+           return $_[1] eq $hash{key};
+       }
+    };
     use overload '""' => sub { "stringified" };
     use overload 'eq' => sub {"$_[0]" eq "$_[1]"};
 }
@@ -42,6 +53,9 @@ tie my %tied_hash, 'Tie::StdHash';
 our $ov_obj = Test::Object::WithOverload->new;
 our $obj = Test::Object::NoOverload->new;
 
+tie my %refh, 'Tie::RefHash';
+$refh{$ov_obj} = 1;
+
 my @keyandmore = qw(key and more);
 my @fooormore = qw(foo or more);
 my %keyandmore = map { $_ => 0 } @keyandmore;
@@ -62,7 +76,13 @@ while (<DATA>) {
     my $tstr = "$left ~~ $right";
 
     test_again:
-    my $res = eval $tstr;
+    my $res;
+    if ($note =~ /NOWARNINGS/) {
+       $res = eval "no warnings; $tstr";
+    }
+    else {
+       $res = eval $tstr;
+    }
 
     chomp $@;
 
@@ -146,15 +166,15 @@ __DATA__
 
 # Any ~~ object overloaded
 !      \&fatal         $ov_obj
-       'magic'         $ov_obj
-!      'not magic'     $ov_obj
+       'cigam'         $ov_obj
+!      'cigam on'      $ov_obj
 !      $obj            $ov_obj
 !      undef           $ov_obj
 
 # regular object
 @      $obj            $obj
 @      $ov_obj         $obj
-@      \&fatal         $obj
+=@     \&fatal         $obj
 @      \&FALSE         $obj
 @      \&foo           $obj
 @      sub { 1 }       $obj
@@ -171,7 +191,9 @@ __DATA__
 # object (overloaded or not) ~~ Any
        $obj            qr/NoOverload/
        $ov_obj         qr/^stringified$/
-       $ov_obj         "stringified"
+       "$ov_obj"       "stringified"
+       $ov_obj         'magic'
+!      $ov_obj         'not magic'
 
 # ~~ Coderef
        sub{0}          sub { ref $_[0] eq "CODE" }
@@ -243,6 +265,11 @@ __DATA__
 =      %hash           %tied_hash
        %tied_hash      %tied_hash
 !=     {"a"=>"b"}      %tied_hash
+       $ov_obj         %refh
+!      "$ov_obj"       %refh
+       [$ov_obj]       %refh
+!      ["$ov_obj"]     %refh
+       %refh           %refh
 
 #  - an array ref
 #  (since this is symmetrical, tests as well hash~~array)
@@ -322,10 +349,6 @@ __DATA__
 !      $obj            @fooormore
        $obj            [sub{ref shift}]
 
-#  - works with lists instead of arrays
-       "foo"                   qw(foo bar)     TODO
-       "foo"                   ('foo','bar')   TODO
-
 #  - a regex
 =      qr/x/           [qw(foo bar baz quux)]
 =!     qr/y/           [qw(foo bar baz quux)]
@@ -368,7 +391,7 @@ __DATA__
 =      2               "2"
 =      2               "2.0"
 !      2               "2bananas"
-!=     2_3             "2_3"
+!=     2_3             "2_3"           NOWARNINGS
        FALSE           "0"
 
 # Regex against string