3 # Uncomment this for testing, but don't leave it in for "production", as
4 # we've not yet verified that use works.
10 # Historically constant folding was performed by evaluating the ops, and if
11 # they threw an exception compilation failed. This was seen as buggy, because
12 # even illegal constants in unreachable code would cause failure. So now
13 # illegal expressions are reported at runtime, if the expression is reached,
14 # making constant folding consistent with many other languages, and purely an
15 # optimisation rather than a behaviour change.
19 my ($got, $expected, $name) = @_;
21 print "not ok $test - $name\n";
22 my @caller = caller(1);
23 print "# Failed test at $caller[1] line $caller[2]\n";
25 print "# Got '$got'\n";
27 print "# Got undef\n";
29 print "# Expected $expected\n";
34 my ($got, $pattern, $name) = @_;
36 if (defined $got && $got =~ $pattern) {
37 print "ok $test - $name\n";
38 # Principle of least surprise - maintain the expected interface, even
39 # though we aren't using it here (yet).
42 failed($got, $pattern, $name);
46 my ($got, $expect, $name) = @_;
48 if (defined $got && $got eq $expect) {
49 print "ok $test - $name\n";
52 failed($got, "'$expect'", $name);
56 my ($got, $name) = @_;
59 print "ok $test - $name\n";
62 failed($got, "a true value", $name);
66 $a = eval '$b = 0/0 if 0; 3';
67 is ($a, 3, 'constants in conditionals don\'t affect constant folding');
68 is ($@, '', 'no error');
71 $a = eval 'if ($b) {return sqrt -3} 3';
72 is ($a, 3, 'variables in conditionals don\'t affect constant folding');
73 is ($@, '', 'no error');
76 $b = eval q{if ($b) {return log 0} 4};
77 is ($b, 4, 'inner eval folds constant');
78 is ($@, '', 'no error');
81 is ($a, 5, 'outer eval folds constant');
82 is ($@, '', 'no error');
84 # warn and die hooks should be disabled during constant folding
88 local $SIG{__WARN__} = sub { $c++ };
89 local $SIG{__DIE__} = sub { $c+= 2 };
91 is($c, 0, "premature warn/die: $c");
93 is($c, 1, "missing warn hook");
98 like ($@, qr/division/, "eval caught division");
99 is($c, 2, "missing die hook");
102 # [perl #20444] Constant folding should not change the meaning of match
106 $_="foo"; my $jing = 1;
107 ok scalar $jing =~ (1 ? /foo/ : /bar/),
108 'lone m// is not bound via =~ after ? : folding';
109 ok scalar $jing =~ (0 || /foo/),
110 'lone m// is not bound via =~ after || folding';
111 ok scalar $jing =~ (1 ? s/foo/foo/ : /bar/),
112 'lone s/// is not bound via =~ after ? : folding';
113 ok scalar $jing =~ (0 || s/foo/foo/),
114 'lone s/// is not bound via =~ after || folding';
116 ok scalar $jing =~ (1 ? y/fo// : /bar/),
117 'lone y/// is not bound via =~ after ? : folding';
118 ok scalar $jing =~ (0 || y/fo//),
119 'lone y/// is not bound via =~ after || folding';