t/op/smartkve.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     require './test.pl';
   6     set_up_inc('../lib');
   7 }
   8 use strict;
   9 use warnings;
  10 no warnings 'experimental::refaliasing';
  11 use vars qw($data $array $values $hash $errpat);
  12
  13 plan 'no_plan';
  14
  15 my $empty;
  16
  17 # Keys -- errors
  18 $errpat = qr/Experimental keys on scalar is now forbidden/;
  19
  20 eval "keys undef";
  21 like($@, $errpat,
  22   'Errors: keys undef throws error'
  23 );
  24
  25 undef $empty;
  26 eval q"keys $empty";
  27 like($@, $errpat,
  28   'Errors: keys $undef throws error'
  29 );
  30
  31 is($empty, undef, 'keys $undef does not vivify $undef');
  32
  33 eval "keys 3";
  34 like($@, qr/Type of arg 1 to keys must be hash/,
  35   'Errors: keys CONSTANT throws error'
  36 );
  37
  38 eval "keys qr/foo/";
  39 like($@, $errpat,
  40   'Errors: keys qr/foo/ throws error'
  41 );
  42
  43 eval q"keys $hash qw/fo bar/";
  44 like($@, $errpat,
  45   'Errors: keys $hash, @stuff throws error'
  46 ) or print "# Got: $@";
  47
  48 # Values -- errors
  49 $errpat = qr/Experimental values on scalar is now forbidden/;
  50
  51 eval "values undef";
  52 like($@, $errpat,
  53   'Errors: values undef throws error'
  54 );
  55
  56 undef $empty;
  57 eval q"values $empty";
  58 like($@, $errpat,
  59   'Errors: values $undef throws error'
  60 );
  61
  62 is($empty, undef, 'values $undef does not vivify $undef');
  63
  64 eval "values 3";
  65 like($@, qr/Type of arg 1 to values must be hash/,
  66   'Errors: values CONSTANT throws error'
  67 );
  68
  69 eval "values qr/foo/";
  70 like($@, $errpat,
  71   'Errors: values qr/foo/ throws error'
  72 );
  73
  74 eval q"values $hash qw/fo bar/";
  75 like($@, $errpat,
  76   'Errors: values $hash, @stuff throws error'
  77 ) or print "# Got: $@";
  78
  79 # Each -- errors
  80 $errpat = qr/Experimental each on scalar is now forbidden/;
  81
  82 eval "each undef";
  83 like($@, $errpat,
  84   'Errors: each undef throws error'
  85 );
  86
  87 undef $empty;
  88 eval q"each $empty";
  89 like($@, $errpat,
  90   'Errors: each $undef throws error'
  91 );
  92
  93 is($empty, undef, 'each $undef does not vivify $undef');
  94
  95 eval "each 3";
  96 like($@, qr/Type of arg 1 to each must be hash/,
  97   'Errors: each CONSTANT throws error'
  98 );
  99
 100 eval "each qr/foo/";
 101 like($@, $errpat,
 102   'Errors: each qr/foo/ throws error'
 103 );
 104
 105 eval q"each $hash qw/foo bar/";
 106 like($@, $errpat,
 107   'Errors: each $hash, @stuff throws error'
 108 ) or print "# Got: $@";
 109
 110 use feature 'refaliasing';
 111 my $a = 7;
 112 our %h;
 113 \$h{f} = \$a;
 114 ($a, $b) = each %h;
 115 is "$a $b", "f 7", 'each %hash in list assignment';
 116 $a = 7;
 117 ($a, $b) = (3, values %h);
 118 is "$a $b", "3 7", 'values %hash in list assignment';
 119 *a = sub { \@_ }->($a);
 120 $a = 7;
 121 ($a, $b) = each our @a;
 122 is "$a $b", "0 7", 'each @array in list assignment';
 123 $a = 7;
 124 ($a, $b) = (3, values @a);
 125 is "$a $b", "3 7", 'values @array in list assignment';