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;
my %empty;
+my @sparse; $sparse[2] = 2;
my $deep1 = []; push @$deep1, \$deep1;
my $deep2 = []; push @$deep2, \$deep2;
}
{
- package Test::Object::CopyOverload;
- sub new { bless { key => 'magic' } }
- use overload '~~' => sub { my %hash = %{ $_[0] }; $_[1] eq $hash{key} };
+ package Test::Object::StringOverload;
+ use overload '""' => sub { "object" }, fallback => 1;
+ sub new { bless { key => 1 } }
}
-our $ov_obj = Test::Object::CopyOverload->new;
+{
+ package Test::Object::WithOverload;
+ 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);
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+/;
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 $@;
$tstr = "$right ~~ $left";
goto test_again;
}
+ }
}
sub foo {}
# 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 TODO
-@ \&fatal $obj
+@ $ov_obj $obj
+=@ \&fatal $obj
@ \&FALSE $obj
@ \&foo $obj
@ sub { 1 } $obj
@ "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
-# TODO
+ $obj qr/NoOverload/
+ $ov_obj qr/^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" }
qr// \&bar
! [1] \&foo
! {a=>1} \&foo
+ $obj sub { ref($_[0]) =~ /NoOverload/ }
+ $ov_obj sub { ref($_[0]) =~ /WithOverload/ }
# empty stuff matches, because the sub is never called:
[] \&foo
{} \&foo
+{} \&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
= %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)
= \@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}
# - 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
= \@nums @tied_nums
= @nums @tied_nums
-# - works with lists instead of arrays
- "foo" qw(foo bar) TODO
- "foo" ('foo','bar') TODO
+# - an object
+! $obj @fooormore
+ $obj [sub{ref shift}]
# - 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(1foo 2bar)]
+ 2 [qw(1.00 2.00)]
2 [qw(foo 2)]
2.0_0e+0 [qw(foo 2)]
! 2 [qw(1foo bar2)]
! "2" [qw(1foo 2bar)]
"2bar" [qw(1foo 2bar)]
+# - undef
+ undef [1, 2, undef, 4]
+! undef [1, 2, [undef], 4]
+! undef @fooormore
+ undef @sparse
+ undef [undef]
+! 0 [undef]
+! "" [undef]
+! undef [0]
+! undef [""]
+
+# - nested arrays and ~~ distributivity
+ 11 [[11]]
+! 11 [[12]]
+ "foo" [{foo => "bar"}]
+! "bar" [{foo => "bar"}]
+
# Number against number
2 2
20 2_0
! 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/
12345 qr/3/
! 12345 qr/7/
-# TODO ranges
-
# array/hash against string
@fooormore "".\@fooormore
! @keyandmore "".\@fooormore
projects / p5sagit/p5-mst-13.2.git / blobdiff