This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
startkve.t: Refactor setting of $errpat
[perl5.git] / 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     $errpat = qr/Experimental $_[0] on scalar is now forbidden/;
19 }
20
21 # Keys -- errors
22 set_errpat 'keys';
23
24 eval "keys undef";
25 like($@, $errpat,
26   'Errors: keys undef throws error'
27 );
28
29 undef $empty;
30 eval q"keys $empty";
31 like($@, $errpat,
32   'Errors: keys $undef throws error'
33 );
34
35 is($empty, undef, 'keys $undef does not vivify $undef');
36
37 eval "keys 3";
38 like($@, qr/Type of arg 1 to keys must be hash/,
39   'Errors: keys CONSTANT throws error'
40 );
41
42 eval "keys qr/foo/";
43 like($@, $errpat,
44   'Errors: keys qr/foo/ throws error'
45 );
46
47 eval q"keys $hash qw/fo bar/";
48 like($@, $errpat,
49   'Errors: keys $hash, @stuff throws error'
50 ) or print "# Got: $@";
51
52 # Values -- errors
53 set_errpat 'values';
54
55 eval "values undef";
56 like($@, $errpat,
57   'Errors: values undef throws error'
58 );
59
60 undef $empty;
61 eval q"values $empty";
62 like($@, $errpat,
63   'Errors: values $undef throws error'
64 );
65
66 is($empty, undef, 'values $undef does not vivify $undef');
67
68 eval "values 3";
69 like($@, qr/Type of arg 1 to values must be hash/,
70   'Errors: values CONSTANT throws error'
71 );
72
73 eval "values qr/foo/";
74 like($@, $errpat,
75   'Errors: values qr/foo/ throws error'
76 );
77
78 eval q"values $hash qw/fo bar/";
79 like($@, $errpat,
80   'Errors: values $hash, @stuff throws error'
81 ) or print "# Got: $@";
82
83 # Each -- errors
84 set_errpat 'each';
85
86 eval "each undef";
87 like($@, $errpat,
88   'Errors: each undef throws error'
89 );
90
91 undef $empty;
92 eval q"each $empty";
93 like($@, $errpat,
94   'Errors: each $undef throws error'
95 );
96
97 is($empty, undef, 'each $undef does not vivify $undef');
98
99 eval "each 3";
100 like($@, qr/Type of arg 1 to each must be hash/,
101   'Errors: each CONSTANT throws error'
102 );
103
104 eval "each qr/foo/";
105 like($@, $errpat,
106   'Errors: each qr/foo/ throws error'
107 );
108
109 eval q"each $hash qw/foo bar/";
110 like($@, $errpat,
111   'Errors: each $hash, @stuff throws error'
112 ) or print "# Got: $@";