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     $res = eval $tstr // "";    #/ <- fix syntax colouring
  52
  53     die $@ if $@ ne "";
  54     ok( ($yn =~ /!/ xor $res), "$tstr: $res");
  55 }
  56
  57
  58
  59 sub foo {}
  60 sub bar {2}
  61 sub fatal {die}
  62
  63 sub a_const() {die if @_; "a constant"}
  64 sub b_const() {die if @_; "a constant"}
  65
  66 __DATA__
  67 # CODE ref against argument
  68 #  - arg is code ref
  69         \&foo           \&foo
  70 !       \&foo           sub {}
  71 !       \&foo           \&bar
  72
  73 # - arg is not code ref
  74         1               sub{shift}
  75 !       0               sub{shift}
  76         1               sub{scalar @_}
  77         []              \&bar
  78         {}              \&bar
  79         qr//            \&bar
  80
  81 # - null-prototyped subs
  82         a_const         "a constant"
  83         a_const         a_const
  84         a_const         b_const
  85
  86 # HASH ref against:
  87 #   - another hash ref
  88         {}              {}
  89 !       {}              {1 => 2}
  90         {1 => 2}        {1 => 2}
  91         {1 => 2}        {1 => 3}
  92 !       {1 => 2}        {2 => 3}
  93         \%main::        {map {$_ => 'x'} keys %main::}
  94
  95 #  - tied hash ref
  96         \%hash          \%tied_hash
  97         \%tied_hash     \%tied_hash
  98
  99 #  - an array ref
 100         \%::            [keys %main::]
 101 !       \%::            []
 102         {"" => 1}       [undef]
 103         { foo => 1 }    ["foo"]
 104         { foo => 1 }    ["foo", "bar"]
 105         \%hash          ["foo", "bar"]
 106         \%hash          ["foo"]
 107 !       \%hash          ["quux"]
 108         \%hash          [qw(foo quux)]
 109
 110 #  - a regex
 111         {foo => 1}      qr/^(fo[ox])$/
 112 !       +{0..100}       qr/[13579]$/
 113
 114 #  - a string
 115         +{foo => 1, bar => 2}   "foo"
 116 !       +{foo => 1, bar => 2}   "baz"
 117
 118
 119 # ARRAY ref against:
 120 #  - another array ref
 121         []              []
 122 !       []              [1]
 123         [["foo"], ["bar"]]      [qr/o/, qr/a/]
 124         ["foo", "bar"]          [qr/o/, qr/a/]
 125 !       ["foo", "bar"]          [qr/o/, "foo"]
 126         $deep1          $deep1
 127 !       $deep1          $deep2
 128
 129         \@nums          \@tied_nums
 130
 131 #  - a regex
 132         [qw(foo bar baz quux)]  qr/x/
 133 !       [qw(foo bar baz quux)]  qr/y/
 134
 135 # - a number
 136         [qw(1foo 2bar)]         2
 137
 138 # - a string
 139 !       [qw(1foo 2bar)]         "2"
 140
 141 # Number against number
 142         2               2
 143 !       2               3
 144
 145 # Number against string
 146         2               "2"
 147         2               "2.0"
 148 !       2               "2bananas"
 149 !       2_3             "2_3"
 150
 151 # Regex against string
 152         qr/x/           "x"
 153 !       qr/y/           "x"
 154
 155 # Regex against number
 156         12345           qr/3/
 157
 158
 159 # Test the implicit referencing
 160         @nums           7
 161         @nums           \@nums
 162 !       @nums           \\@nums
 163         @nums           [1..10]
 164 !       @nums           [0..9]
 165
 166         %hash           "foo"
 167         %hash           /bar/
 168         %hash           [qw(bar)]
 169 !       %hash           [qw(a b c)]
 170         %hash           %hash
 171         %hash           {%hash}
 172         %hash           %tied_hash
 173         %tied_hash      %tied_hash
 174         %hash           { foo => 5, bar => 10 }
 175 !       %hash           { foo => 5, bar => 10, quux => 15 }
 176
 177         @nums           {  1, '',  2, '' }
 178         @nums           {  1, '', 12, '' }
 179 !       @nums           { 11, '', 12, '' }