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 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,/;
  23 }
  24
  25 # Keys -- errors
  26 set_errpat 'keys';
  27
  28 eval "keys undef";
  29 like($@, $errpat,
  30   'Errors: keys undef throws error'
  31 );
  32
  33 undef $empty;
  34 eval q"keys $empty";
  35 like($@, $errpat,
  36   'Errors: keys $undef throws error'
  37 );
  38
  39 is($empty, undef, 'keys $undef does not vivify $undef');
  40
  41 eval "keys 3";
  42 like($@, qr/Type of arg 1 to keys must be hash/,
  43   'Errors: keys CONSTANT throws error'
  44 );
  45
  46 eval "keys qr/foo/";
  47 like($@, $errpat,
  48   'Errors: keys qr/foo/ throws error'
  49 );
  50
  51 eval q"keys $hash qw/fo bar/";
  52 like($@, $errpat,
  53   'Errors: keys $hash, @stuff throws error'
  54 ) or print "# Got: $@";
  55
  56 # Values -- errors
  57 set_errpat 'values';
  58
  59 eval "values undef";
  60 like($@, $errpat,
  61   'Errors: values undef throws error'
  62 );
  63
  64 undef $empty;
  65 eval q"values $empty";
  66 like($@, $errpat,
  67   'Errors: values $undef throws error'
  68 );
  69
  70 is($empty, undef, 'values $undef does not vivify $undef');
  71
  72 eval "values 3";
  73 like($@, qr/Type of arg 1 to values must be hash/,
  74   'Errors: values CONSTANT throws error'
  75 );
  76
  77 eval "values qr/foo/";
  78 like($@, $errpat,
  79   'Errors: values qr/foo/ throws error'
  80 );
  81
  82 eval q"values $hash qw/fo bar/";
  83 like($@, $errpat,
  84   'Errors: values $hash, @stuff throws error'
  85 ) or print "# Got: $@";
  86
  87 # Each -- errors
  88 set_errpat 'each';
  89
  90 eval "each undef";
  91 like($@, $errpat,
  92   'Errors: each undef throws error'
  93 );
  94
  95 undef $empty;
  96 eval q"each $empty";
  97 like($@, $errpat,
  98   'Errors: each $undef throws error'
  99 );
 100
 101 is($empty, undef, 'each $undef does not vivify $undef');
 102
 103 eval "each 3";
 104 like($@, qr/Type of arg 1 to each must be hash/,
 105   'Errors: each CONSTANT throws error'
 106 );
 107
 108 eval "each qr/foo/";
 109 like($@, $errpat,
 110   'Errors: each qr/foo/ throws error'
 111 );
 112
 113 eval q"each $hash qw/foo bar/";
 114 like($@, $errpat,
 115   'Errors: each $hash, @stuff throws error'
 116 ) or print "# Got: $@";