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;
+my %empty;
+my @sparse; $sparse[2] = 2;
+
my $deep1 = []; push @$deep1, \$deep1;
my $deep2 = []; push @$deep2, \$deep2;
}
{
- package Test::Object::CopyOverload;
+ package Test::Object::StringOverload;
+ use overload '""' => sub { "object" }, fallback => 1;
sub new { bless { key => 1 } }
- use overload '~~' => sub { my %hash = %{ $_[0] }; %hash ~~ $_[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;
+
+tie my %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>) {
next if /^#/ || !/\S/;
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 $@;
}
}
-
-
sub foo {}
sub bar {42}
sub gorch {42}
sub fatal {die "fatal sub\n"}
+# to test constant folding
sub FALSE() { 0 }
sub TRUE() { 1 }
-sub TWO() { 1 }
+sub NOT_DEF() { undef }
# Prefix character :
# - expected to match
! !1 undef
undef undef
(my $u) undef
+ NOT_DEF undef
+ &NOT_DEF undef
# Any ~~ object overloaded
-# object overloaded ~~ Any
- $ov_obj $ov_obj
-=@ $ov_obj \&fatal
-=! $ov_obj \&FALSE
-=! $ov_obj \&foo
-= $ov_obj \&bar
-= $ov_obj sub { shift ~~ "key" }
-=! $ov_obj sub { shift ne "key" }
-=! $ov_obj sub { shift ~~ "foo" }
-= $ov_obj %keyandmore TODO
-=! $ov_obj %fooormore
-= $ov_obj {"key" => 1}
-= $ov_obj {"key" => 1, bar => 2} TODO
-=! $ov_obj {"foo" => 1}
-= $ov_obj @keyandmore
-=! $ov_obj @fooormore
-= $ov_obj ["key" => 1]
-=! $ov_obj ["foo" => 1]
-= $ov_obj /key/
-=! $ov_obj /foo/
-= $ov_obj qr/Key/i
-=! $ov_obj qr/foo/
-= $ov_obj "key"
-=! $ov_obj "foo"
-=! $ov_obj FALSE
+! \&fatal $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 $ov_obj
-=@ $obj $obj
-=@ $obj \&fatal
-=@ $obj \&FALSE
-=@ $obj \&foo
-=@ $obj sub { 1 }
-=@ $obj sub { 0 }
-=@ $obj %keyandmore
-=@ $obj {"key" => 1}
-=@ $obj @fooormore
-=@ $obj ["key" => 1]
-=@ $obj /key/
-=@ $obj qr/key/
-=@ $obj "key"
-=@ $obj FALSE
+@ $obj $obj
+@ $ov_obj $obj
+=@ \&fatal $obj
+@ \&FALSE $obj
+@ \&foo $obj
+@ sub { 1 } $obj
+@ sub { 0 } $obj
+@ %keyandmore $obj
+@ {"key" => 1} $obj
+@ @fooormore $obj
+@ ["key" => 1] $obj
+@ /key/ $obj
+@ qr/key/ $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
+ $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" }
! 0 sub{shift}
! undef sub{shift}
undef sub{not shift}
+ NOT_DEF sub{not shift}
+ &NOT_DEF sub{not shift}
FALSE sub{not shift}
[1] \&bar
{a=>1} \&bar
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
+ @empty \&foo
+ %empty \&foo
! qr// \&foo
! undef \&foo
undef \&bar
# sub is not called on empty hashes / arrays
[] \&fatal
+{} \&fatal
-
-# - null-prototyped subs
-! undef \&FALSE
- undef \&TRUE
-! 0 \&FALSE
- 0 \&TRUE
-! 1 \&FALSE
- 1 \&TRUE
-! \&FALSE \&foo
-
-# - non-null-prototyped subs
- bar gorch
-@ fatal bar
+ @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
{} {}
-! {} {1 => 2}
+=! {} {1 => 2}
{1 => 2} {1 => 2}
{1 => 2} {1 => 3}
-! {1 => 2} {2 => 3}
- \%main:: {map {$_ => 'x'} keys %main::}
+=! {1 => 2} {2 => 3}
+= \%main:: {map {$_ => 'x'} keys %main::}
# - tied hash ref
- \%hash \%tied_hash
+= \%hash \%tied_hash
\%tied_hash \%tied_hash
+!= {"a"=>"b"} \%tied_hash
+= %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
- \%:: [keys %main::]
-! \%:: []
- {"" => 1} [undef]
- { foo => 1 } ["foo"]
- { foo => 1 } ["foo", "bar"]
- \%hash ["foo", "bar"]
- \%hash ["foo"]
-! \%hash ["quux"]
- \%hash [qw(foo quux)]
+# (since this is symmetrical, tests as well hash~~array)
+= [keys %main::] \%::
+= [qw[STDIN STDOUT]] \%::
+=! [] \%::
+=! [""] {}
+=! [] {}
+=! @empty {}
+= [undef] {"" => 1}
+= [""] {"" => 1}
+= ["foo"] { foo => 1 }
+= ["foo", "bar"] { foo => 1 }
+= ["foo", "bar"] \%hash
+= ["foo"] \%hash
+=! ["quux"] \%hash
+= [qw(foo quux)] \%hash
+= @fooormore { foo => 1, or => 2, more => 3 }
+= @fooormore %fooormore
+= @fooormore \%fooormore
+= \@fooormore %fooormore
# - a regex
- {foo => 1} qr/^(fo[ox])$/
-! +{0..99} qr/[13579]$/
-
-# - a string
- +{foo => 1, bar => 2} "foo"
-! +{foo => 1, bar => 2} "baz"
-
+= qr/^(fo[ox])$/ {foo => 1}
+= /^(fo[ox])$/ %fooormore
+=! qr/[13579]$/ +{0..99}
+=! qr/a*/ {}
+= qr/a*/ {b=>2}
+= qr/B/i {b=>2}
+= /B/i {b=>2}
+=! qr/a+/ {b=>2}
+= qr/^à/ {"à"=>2}
+
+# - a scalar
+ "foo" +{foo => 1, bar => 2}
+ "foo" %fooormore
+! "baz" +{foo => 1, bar => 2}
+! "boz" %fooormore
+! 1 +{foo => 1, bar => 2}
+! 1 %fooormore
+ 1 { 1 => 3 }
+ 1.0 { 1 => 3 }
+! "1.0" { 1 => 3 }
+! "1.0" { 1.0 => 3 }
+ "1.0" { "1.0" => 3 }
+ "à" { "à" => "À" }
+
+# - undef
+! undef { hop => 'zouu' }
+! undef %hash
+! undef +{"" => "empty key"}
+! undef {}
# ARRAY ref against:
# - another array ref
[] []
-! [] [1]
+=! [] [1]
[["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", "", "bar"] [qr/o/, undef, "bar"]
$deep1 $deep1
+ @$deep1 @$deep1
! $deep1 $deep2
- \@nums \@tied_nums
+= \@nums \@tied_nums
+= @nums \@tied_nums
+= \@nums @tied_nums
+= @nums @tied_nums
+
+# - an object
+! $obj @fooormore
+ $obj [sub{ref shift}]
# - a regex
- [qw(foo bar baz quux)] qr/x/
-! [qw(foo bar baz quux)] qr/y/
+= 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
- [qw(1foo 2bar)] 2
- [qw(foo 2)] 2
- [qw(foo 2)] 2.0_0e+0
-! [qw(1foo bar2)] 2
+ 2 [qw(1.00 2.00)]
+ 2 [qw(foo 2)]
+ 2.0_0e+0 [qw(foo 2)]
+! 2 [qw(1foo bar2)]
# - a string
-! [qw(1foo 2bar)] "2"
- [qw(1foo 2bar)] "2bar"
+! "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
+! (my $u) 0
# Number against string
- 2 "2"
- 2 "2.0"
+= 2 "2"
+= 2 "2.0"
! 2 "2bananas"
-! 2_3 "2_3"
+!= 2_3 "2_3" NOWARNINGS
FALSE "0"
+! undef "0"
+! undef ""
# Regex against string
- qr/x/ "x"
-! qr/y/ "x"
+ "x" qr/x/
+! "x" qr/y/
# Regex against number
12345 qr/3/
+! 12345 qr/7/
+# array/hash against string
+ @fooormore "".\@fooormore
+! @keyandmore "".\@fooormore
+ %fooormore "".\%fooormore
+! %keyandmore "".\%fooormore
# Test the implicit referencing
- @nums 7
+ 7 @nums
@nums \@nums
! @nums \\@nums
@nums [1..10]
! @nums [0..9]
- %hash "foo"
- %hash /bar/
- %hash [qw(bar)]
-! %hash [qw(a b c)]
+ "foo" %hash
+ /bar/ %hash
+ [qw(bar)] %hash
+! [qw(a b c)] %hash
%hash %hash
%hash +{%hash}
%hash \%hash
projects / p5sagit/p5-mst-13.2.git / blobdiff