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 our ($data, $array, $values, $hash, $errpat);
  12
  13 plan 'no_plan';
  14
  15 my $empty;
  16
  17 sub set_errpat {
  18     # Checking for a comma after the line number ensures that we are using
  19     # yyerror for the error, rather than croak.  yyerror is preferable for
  20     # compile-time errors.
  21     $errpat =
  22        qr/Experimental $_[0] on scalar is now forbidden .* line 1\.(?x:
  23          ).*Type of arg 1 to $_[0] must be hash or array \(not (?x:
  24          ).*line 1,/s;
  25 }
  26
  27 # Keys -- errors
  28 set_errpat 'keys';
  29
  30 eval "keys undef";
  31 like($@, $errpat,
  32   'Errors: keys undef throws error'
  33 );
  34
  35 undef $empty;
  36 eval q"keys $empty";
  37 like($@, $errpat,
  38   'Errors: keys $undef throws error'
  39 );
  40
  41 is($empty, undef, 'keys $undef does not vivify $undef');
  42
  43 eval "keys 3";
  44 like($@, qr/Type of arg 1 to keys must be hash/,
  45   'Errors: keys CONSTANT throws error'
  46 );
  47
  48 eval "keys qr/foo/";
  49 like($@, $errpat,
  50   'Errors: keys qr/foo/ throws error'
  51 );
  52
  53 eval q"keys $hash qw/fo bar/";
  54 like($@, $errpat,
  55   'Errors: keys $hash, @stuff throws error'
  56 ) or print "# Got: $@";
  57
  58 # Values -- errors
  59 set_errpat 'values';
  60
  61 eval "values undef";
  62 like($@, $errpat,
  63   'Errors: values undef throws error'
  64 );
  65
  66 undef $empty;
  67 eval q"values $empty";
  68 like($@, $errpat,
  69   'Errors: values $undef throws error'
  70 );
  71
  72 is($empty, undef, 'values $undef does not vivify $undef');
  73
  74 eval "values 3";
  75 like($@, qr/Type of arg 1 to values must be hash/,
  76   'Errors: values CONSTANT throws error'
  77 );
  78
  79 eval "values qr/foo/";
  80 like($@, $errpat,
  81   'Errors: values qr/foo/ throws error'
  82 );
  83
  84 eval q"values $hash qw/fo bar/";
  85 like($@, $errpat,
  86   'Errors: values $hash, @stuff throws error'
  87 ) or print "# Got: $@";
  88
  89 # Each -- errors
  90 set_errpat 'each';
  91
  92 eval "each undef";
  93 like($@, $errpat,
  94   'Errors: each undef throws error'
  95 );
  96
  97 undef $empty;
  98 eval q"each $empty";
  99 like($@, $errpat,
 100   'Errors: each $undef throws error'
 101 );
 102
 103 is($empty, undef, 'each $undef does not vivify $undef');
 104
 105 eval "each 3";
 106 like($@, qr/Type of arg 1 to each must be hash/,
 107   'Errors: each CONSTANT throws error'
 108 );
 109
 110 eval "each qr/foo/";
 111 like($@, $errpat,
 112   'Errors: each qr/foo/ throws error'
 113 );
 114
 115 eval q"each $hash qw/foo bar/";
 116 like($@, $errpat,
 117   'Errors: each $hash, @stuff throws error'
 118 ) or print "# Got: $@";