use overload '~~' => sub { my %hash = %{ $_[0] }; %hash ~~ $_[1] };
}
-{
- package Test::Object::OverloadCodeRef;
- sub new { bless $_[1] }
- use overload '~~' => sub { shift->($_[1]) };
-}
-
our $ov_obj = Test::Object::CopyOverload->new;
our $obj = Test::Object::NoOverload->new;
-our $false_obj = Test::Object::OverloadCodeRef->new(sub { 0 });
-our $true_obj = Test::Object::OverloadCodeRef->new(sub { 1 });
+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);
}
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 );
}
}
}
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
! 0 sub{shift}
! undef sub{shift}
undef sub{not shift}
+ FALSE sub{not shift}
1 sub{scalar @_}
[] \&bar
{} \&bar
@ [] \&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"
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
# - a regex
{foo => 1} qr/^(fo[ox])$/
-! +{0..100} qr/[13579]$/
+! +{0..99} qr/[13579]$/
# - a string
+{foo => 1, bar => 2} "foo"
# 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"
%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 }