Really check that sysread(I, $x, 1, -4) dies with "Offset outside string"
[p5sagit/p5-mst-13.2.git] / t / op / smartmatch.t
index 3124b7a..33836b3 100644 (file)
@@ -6,9 +6,12 @@ BEGIN {
     require './test.pl';
 }
 use strict;
+use warnings;
+no warnings 'uninitialized';
 
 use Tie::Array;
 use Tie::Hash;
+use if !$ENV{PERL_CORE_MINITEST}, "Tie::RefHash";
 
 # Predeclare vars used in the tests:
 my @empty;
@@ -32,15 +35,37 @@ tie my %tied_hash, 'Tie::StdHash';
 }
 
 {
+    package Test::Object::StringOverload;
+    use overload '""' => sub { "object" }, fallback => 1;
+    sub new { bless { key => 1 } }
+}
+
+{
     package Test::Object::WithOverload;
-    sub new { bless { key => 'magic' } }
-    use overload '~~' => sub { my %hash = %{ $_[0] }; $_[1] eq $hash{key} };
+    sub new { bless { key => ($_[1] // 'magic') } }
+    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]"};
 }
 
 our $ov_obj = Test::Object::WithOverload->new;
+our $ov_obj_2 = Test::Object::WithOverload->new("object");
 our $obj = Test::Object::NoOverload->new;
+our $str_obj = Test::Object::StringOverload->new;
+
+my %refh;
+if (!$ENV{PERL_CORE_MINITEST}) {
+    tie %refh, 'Tie::RefHash';
+    $refh{$ov_obj} = 1;
+}
 
 my @keyandmore = qw(key and more);
 my @fooormore = qw(foo or more);
@@ -48,9 +73,10 @@ my %keyandmore = map { $_ => 0 } @keyandmore;
 my %fooormore = map { $_ => 0 } @fooormore;
 
 # Load and run the tests
-plan "no_plan";
+plan tests => 322;
 
 while (<DATA>) {
+  SKIP: {
     next if /^#/ || !/\S/;
     chomp;
     my ($yn, $left, $right, $note) = split /\t+/;
@@ -62,7 +88,16 @@ while (<DATA>) {
     my $tstr = "$left ~~ $right";
 
     test_again:
-    my $res = eval $tstr;
+    my $res;
+    if ($note =~ /NOWARNINGS/) {
+       $res = eval "no warnings; $tstr";
+    }
+    elsif ($note =~ /MINISKIP/ && $ENV{PERL_CORE_MINITEST}) {
+       skip("Doesn't work with miniperl", $yn =~ /=/ ? 2 : 1);
+    }
+    else {
+       $res = eval $tstr;
+    }
 
     chomp $@;
 
@@ -83,6 +118,7 @@ while (<DATA>) {
        $tstr = "$right ~~ $left";
        goto test_again;
     }
+  }
 }
 
 sub foo {}
@@ -146,15 +182,19 @@ __DATA__
 
 # Any ~~ object overloaded
 !      \&fatal         $ov_obj
-       'magic'         $ov_obj
-!      'not magic'     $ov_obj
+       'cigam'         $ov_obj
+!      'cigam on'      $ov_obj
+!      ['cigam']       $ov_obj
+!      ['stringified'] $ov_obj
+!      { cigam => 1 }  $ov_obj
+!      { stringified => 1 }    $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
@@ -168,10 +208,34 @@ __DATA__
 @      "key"           $obj
 @      FALSE           $obj
 
+# regular object with "" overload
+@      $obj            $str_obj
+=@     \&fatal         $str_obj
+@      \&FALSE         $str_obj
+@      \&foo           $str_obj
+@      sub { 1 }       $str_obj
+@      sub { 0 }       $str_obj
+@      %keyandmore     $str_obj
+@      {"object" => 1} $str_obj
+@      @fooormore      $str_obj
+@      ["object" => 1] $str_obj
+@      /object/        $str_obj
+@      qr/object/      $str_obj
+@      "object"        $str_obj
+@      FALSE           $str_obj
+# Those will treat the $str_obj as a string because of fallback:
+!      $ov_obj         $str_obj
+       $ov_obj_2       $str_obj
+
 # object (overloaded or not) ~~ Any
        $obj            qr/NoOverload/
        $ov_obj         qr/^stringified$/
-       $ov_obj         "stringified"
+=      "$ov_obj"       "stringified"
+=      "$str_obj"      "object"
+!=     $ov_obj         "stringified"
+       $str_obj        "object"
+       $ov_obj         'magic'
+!      $ov_obj         'not magic'
 
 # ~~ Coderef
        sub{0}          sub { ref $_[0] eq "CODE" }
@@ -226,6 +290,9 @@ __DATA__
        +{}             \&fatal
        @empty          \&fatal
        %empty          \&fatal
+# sub is not special on the left
+       sub {0}         qr/^CODE/
+       sub {0}         sub { ref shift eq "CODE" }
 
 # HASH ref against:
 #   - another hash ref
@@ -243,6 +310,11 @@ __DATA__
 =      %hash           %tied_hash
        %tied_hash      %tied_hash
 !=     {"a"=>"b"}      %tied_hash
+       $ov_obj         %refh           MINISKIP
+!      "$ov_obj"       %refh           MINISKIP
+       [$ov_obj]       %refh           MINISKIP
+!      ["$ov_obj"]     %refh           MINISKIP
+       %refh           %refh           MINISKIP
 
 #  - an array ref
 #  (since this is symmetrical, tests as well hash~~array)
@@ -266,16 +338,15 @@ __DATA__
 =      \@fooormore     %fooormore
 
 #  - a regex
-# TODO those should be symmetrical
-       qr/^(fo[ox])$/          {foo => 1}
-       /^(fo[ox])$/            %fooormore
+=      qr/^(fo[ox])$/          {foo => 1}
+=      /^(fo[ox])$/            %fooormore
 =!     qr/[13579]$/            +{0..99}
-!      qr/a*/                  {}
+=!     qr/a*/                  {}
 =      qr/a*/                  {b=>2}
-       qr/B/i                  {b=>2}
-       /B/i                    {b=>2}
-!      qr/a+/                  {b=>2}
-       qr/^à/                 {"à"=>2}
+=      qr/B/i                  {b=>2}
+=      /B/i                    {b=>2}
+=!     qr/a+/                  {b=>2}
+=      qr/^à/                 {"à"=>2}
 
 #  - a scalar
        "foo"           +{foo => 1, bar => 2}
@@ -301,14 +372,14 @@ __DATA__
 #  - another array ref
        []                      []
 =!     []                      [1]
-!      [["foo"], ["bar"]]      [qr/o/, qr/a/]
-       [["foo"], ["bar"]]      [qr/ARRAY/, qr/ARRAY/]
+       [["foo"], ["bar"]]      [qr/o/, qr/a/]
+!      [["foo"], ["bar"]]      [qr/ARRAY/, qr/ARRAY/]
        ["foo", "bar"]          [qr/o/, qr/a/]
 !      [qr/o/, qr/a/]          ["foo", "bar"]
        ["foo", "bar"]          [["foo"], ["bar"]]
 !      ["foo", "bar"]          [qr/o/, "foo"]
        ["foo", undef, "bar"]   [qr/o/, undef, "bar"]
-       ["foo", undef, "bar"]   [qr/o/, "",    "bar"]
+!      ["foo", undef, "bar"]   [qr/o/, "",    "bar"]
 !      ["foo", "", "bar"]      [qr/o/, undef, "bar"]
        $deep1                  $deep1
        @$deep1                 @$deep1
@@ -323,17 +394,13 @@ __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)]
-       /x/             [qw(foo bar baz quux)]
-!      /y/             [qw(foo bar baz quux)]
-       /FOO/i          @fooormore
-!      /bar/           @fooormore
+=      qr/x/           [qw(foo bar baz quux)]
+=!     qr/y/           [qw(foo bar baz quux)]
+=      /x/             [qw(foo bar baz quux)]
+=!     /y/             [qw(foo bar baz quux)]
+=      /FOO/i          @fooormore
+=!     /bar/           @fooormore
 
 # - a number
        2               [qw(1.00 2.00)]
@@ -350,6 +417,11 @@ __DATA__
 !      undef           [1, 2, [undef], 4]
 !      undef           @fooormore
        undef           @sparse
+       undef           [undef]
+!      0               [undef]
+!      ""              [undef]
+!      undef           [0]
+!      undef           [""]
 
 # - nested arrays and ~~ distributivity
        11              [[11]]
@@ -363,14 +435,17 @@ __DATA__
 !      2               3
        0               FALSE
        3-2             TRUE
-       undef           0
+!      undef           0
+!      (my $u)         0
 
 # Number against string
 =      2               "2"
 =      2               "2.0"
 !      2               "2bananas"
-!=     2_3             "2_3"
+!=     2_3             "2_3"           NOWARNINGS
        FALSE           "0"
+!      undef           "0"
+!      undef           ""
 
 # Regex against string
        "x"             qr/x/
@@ -380,8 +455,6 @@ __DATA__
        12345           qr/3/
 !      12345           qr/7/
 
-# TODO ranges
-
 # array/hash against string
        @fooormore      "".\@fooormore
 !      @keyandmore     "".\@fooormore