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
 104 #  - a regex
 105         {foo => 1}      qr/^(fo[ox])$/
 106 !       +{0..100}       qr/[13579]$/
 107
 108 #  - a string
 109         +{foo => 1, bar => 2}   "foo"
 110 !       +{foo => 1, bar => 2}   "baz"
 111
 112
 113 # ARRAY ref against:
 114 #  - another array ref
 115         []              []
 116 !       []              [1]
 117         [["foo"], ["bar"]]      [qr/o/, qr/a/]
 118         ["foo", "bar"]          [qr/o/, qr/a/]
 119         $deep1          $deep1
 120 !       $deep1          $deep2
 121
 122         \@nums          \@tied_nums
 123
 124 #  - a regex
 125         [qw(foo bar baz quux)]  qr/x/
 126 !       [qw(foo bar baz quux)]  qr/y/
 127
 128 # - a number
 129         [qw(1foo 2bar)]         2
 130
 131 # - a string
 132 !       [qw(1foo 2bar)]         "2"
 133
 134 # Number against number
 135         2               2
 136 !       2               3
 137
 138 # Number against string
 139         2               "2"
 140         2               "2.0"
 141 !       2               "2bananas"
 142 !       2_3             "2_3"
 143
 144 # Regex against string
 145         qr/x/           "x"
 146 !       qr/y/           "x"
 147
 148 # Regex against number
 149         12345           qr/3/
 150
 151
 152 # Test the implicit referencing
 153         @nums           7
 154         @nums           \@nums
 155 !       @nums           \\@nums
 156         @nums           [1..10]
 157 !       @nums           [0..9]
 158
 159         %hash           "foo"
 160         %hash           /bar/