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