#!./perl BEGIN { chdir 't'; @INC = '../lib'; require './test.pl'; } use strict; use Tie::Array; use Tie::Hash; # The feature mechanism is tested in t/lib/feature/smartmatch: # This file tests the semantics of the operator, without worrying # about feature issues such as scoping etc. # Predeclare vars used in the tests: my $deep1 = []; push @$deep1, \$deep1; my $deep2 = []; push @$deep2, \$deep2; {my $const = "a constant"; sub a_const () {$const}} my @nums = (1..10); tie my @tied_nums, 'Tie::StdArray'; @tied_nums = (1..10); my %hash = (foo => 17, bar => 23); tie my %tied_hash, 'Tie::StdHash'; %tied_hash = %hash; # Load and run the tests my @tests = map [chomp and split /\t+/, $_, 3], grep !/^#/ && /\S/, ; plan tests => 2 * @tests; for my $test (@tests) { my ($yn, $left, $right) = @$test; match_test($yn, $left, $right); match_test($yn, $right, $left); } sub match_test { my ($yn, $left, $right) = @_; die "Bad test spec: ($yn, $left, $right)" unless $yn eq "" || $yn eq "!"; my $tstr = "$left ~~ $right"; my $res; { use feature "~~"; $res = eval $tstr // ""; #/ <- fix syntax colouring } die $@ if $@ ne ""; ok( ($yn =~ /!/ xor $res), "$tstr: $res"); } sub foo {} sub bar {2} sub fatal {die} sub a_const() {die if @_; "a constant"} sub b_const() {die if @_; "a constant"} __DATA__ # CODE ref against argument # - arg is code ref \&foo \&foo ! \&foo sub {} ! \&foo \&bar # - arg is not code ref 1 sub{shift} ! 0 sub{shift} 1 sub{scalar @_} [] \&bar {} \&bar qr// \&bar # - null-prototyped subs a_const "a constant" a_const a_const a_const b_const # HASH ref against: # - another hash ref {} {} ! {} {1 => 2} {1 => 2} {1 => 2} {1 => 2} {1 => 3} ! {1 => 2} {2 => 3} \%main:: {map {$_ => 'x'} keys %main::} # - tied hash ref \%hash \%tied_hash \%tied_hash \%tied_hash # - an array ref \%:: [keys %main::] ! \%:: [] {"" => 1} [undef] # - a regex {foo => 1} qr/^(fo[ox])$/ ! +{0..100} qr/[13579]$/ # - a string +{foo => 1, bar => 2} "foo" ! +{foo => 1, bar => 2} "baz" # ARRAY ref against: # - another array ref [] [] ! [] [1] [["foo"], ["bar"]] [qr/o/, qr/a/] ["foo", "bar"] [qr/o/, qr/a/] $deep1 $deep1 ! $deep1 $deep2 \@nums \@tied_nums # - a regex [qw(foo bar baz quux)] qr/x/ ! [qw(foo bar baz quux)] qr/y/ # - a number [qw(1foo 2bar)] 2 # - a string ! [qw(1foo 2bar)] "2" # Number against number 2 2 ! 2 3 # Number against string 2 "2" 2 "2.0" ! 2 "2bananas" ! 2_3 "2_3" # Regex against string qr/x/ "x" ! qr/y/ "x" # Regex against number 12345 qr/3/ # Test the implicit referencing @nums 7 @nums \@nums ! @nums \\@nums @nums [1..10] ! @nums [0..9] %hash "foo" %hash /bar/