t/op/smartmatch.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't';
   5     @INC = '../lib';
   6     require './test.pl';
   7 }
   8 use strict;
   9
  10 use Tie::Array;
  11 use Tie::Hash;
  12
  13 # The feature mechanism is tested in t/lib/feature/smartmatch:
  14 # This file tests the semantics of the operator, without worrying
  15 # about feature issues such as scoping etc.
  16
  17 # Predeclare vars used in the tests:
  18 my $deep1 = []; push @$deep1, \$deep1;
  19 my $deep2 = []; push @$deep2, \$deep2;
  20
  21 {my $const = "a constant"; sub a_const () {$const}}
  22
  23 my @nums = (1..10);
  24 tie my @tied_nums, 'Tie::StdArray';
  25 @tied_nums =  (1..10);
  26
  27 my %hash = (foo => 17, bar => 23);
  28 tie my %tied_hash, 'Tie::StdHash';
  29 %tied_hash = %hash;
  30
  31 # Load and run the tests
  32 my @tests = map [chomp and split /\t+/, $_, 3], grep !/^#/ && /\S/, <DATA>;
  33 plan tests => 2 * @tests;
  34
  35 for my $test (@tests) {
  36     my ($yn, $left, $right) = @$test;
  37
  38     match_test($yn, $left, $right);
  39     match_test($yn, $right, $left);
  40 }
  41
  42 sub match_test {
  43     my ($yn, $left, $right) = @_;
  44
  45     die "Bad test spec: ($yn, $left, $right)"
  46         unless $yn eq "" || $yn eq "!";
  47
  48     my $tstr = "$left ~~ $right";
  49
  50     my $res;
  51     {
  52         use feature "~~";
  53         $res = eval $tstr // "";        #/ <- fix syntax colouring
  54     }
  55
  56     die $@ if $@ ne "";
  57     ok( ($yn =~ /!/ xor $res), "$tstr: $res");
  58 }
  59
  60
  61
  62 sub foo {}
  63 sub bar {2}
  64 sub fatal {die}
  65
  66 sub a_const() {die if @_; "a constant"}
  67 sub b_const() {die if @_; "a constant"}
  68
  69 __DATA__
  70 # CODE ref against argument
  71 #  - arg is code ref
  72         \&foo           \&foo
  73 !       \&foo           sub {}
  74 !       \&foo           \&bar
  75
  76 # - arg is not code ref
  77         1               sub{shift}
  78 !       0               sub{shift}
  79         1               sub{scalar @_}
  80         []              \&bar
  81         {}              \&bar
  82         qr//            \&bar
  83
  84 # - null-prototyped subs
  85         a_const         "a constant"
  86         a_const         a_const
  87         a_const         b_const
  88
  89 # HASH ref against:
  90 #   - another hash ref
  91         {}              {}
  92 !       {}              {1 => 2}
  93         {1 => 2}        {1 => 2}
  94         {1 => 2}        {1 => 3}
  95 !       {1 => 2}        {2 => 3}
  96         \%main::        {map {$_ => 'x'} keys %main::}
  97
  98 #  - tied hash ref
  99         \%hash          \%tied_hash
 100         \%tied_hash     \%tied_hash
 101
 102 #  - an array ref
 103         \%::            [keys %main::]
 104 !       \%::            []
 105         {"" => 1}       [undef]
 106
 107 #  - a regex
 108         {foo => 1}      qr/^(fo[ox])$/
 109 !       +{0..100}       qr/[13579]$/
 110
 111 #  - a string
 112         +{foo => 1, bar => 2}   "foo"
 113 !       +{foo => 1, bar => 2}   "baz"
 114
 115
 116 # ARRAY ref against:
 117 #  - another array ref
 118         []              []
 119 !       []              [1]
 120         [["foo"], ["bar"]]      [qr/o/, qr/a/]
 121         ["foo", "bar"]          [qr/o/, qr/a/]
 122         $deep1          $deep1
 123 !       $deep1          $deep2
 124
 125         \@nums          \@tied_nums
 126
 127 #  - a regex
 128         [qw(foo bar baz quux)]  qr/x/
 129 !       [qw(foo bar baz quux)]  qr/y/
 130
 131 # - a number
 132         [qw(1foo 2bar)]         2
 133
 134 # - a string
 135 !       [qw(1foo 2bar)]         "2"
 136
 137 # Number against number
 138         2               2
 139 !       2               3
 140
 141 # Number against string
 142         2               "2"
 143         2               "2.0"
 144 !       2               "2bananas"
 145 !       2_3             "2_3"
 146
 147 # Regex against string
 148         qr/x/           "x"
 149 !       qr/y/           "x"
 150
 151 # Regex against number
 152         12345           qr/3/
 153
 154
 155 # Test the implicit referencing
 156         @nums           7
 157         @nums           \@nums
 158 !       @nums           \\@nums
 159         @nums           [1..10]
 160 !       @nums           [0..9]
 161
 162         %hash           "foo"
 163         %hash           /bar/