Commit | Line | Data |
2eaa2210 |
1 | #!./perl -w |
2 | |
2eaa2210 |
3 | # Uncomment this for testing, but don't leave it in for "production", as |
4 | # we've not yet verified that use works. |
5 | # use strict; |
a5871da3 |
6 | |
76c3cfbe |
7 | print "1..13\n"; |
8 | my $test = 0; |
a5871da3 |
9 | |
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. |
16 | |
5f2d9966 |
17 | |
76c3cfbe |
18 | sub failed { |
19 | my ($got, $expected, $name) = @_; |
20 | |
21 | print "not ok $test - $name\n"; |
22 | my @caller = caller(1); |
23 | print "# Failed test at $caller[1] line $caller[2]\n"; |
24 | if (defined $got) { |
25 | print "# Got '$got'\n"; |
26 | } else { |
27 | print "# Got undef\n"; |
28 | } |
29 | print "# Expected $expected\n"; |
30 | return; |
31 | } |
32 | |
33 | sub like { |
34 | my ($got, $pattern, $name) = @_; |
35 | $test = $test + 1; |
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). |
40 | return 1; |
41 | } |
42 | failed($got, $pattern, $name); |
43 | } |
44 | |
45 | sub is { |
46 | my ($got, $expect, $name) = @_; |
47 | $test = $test + 1; |
48 | if (defined $got && $got eq $expect) { |
49 | print "ok $test - $name\n"; |
50 | return 1; |
51 | } |
52 | failed($got, "'$expect'", $name); |
53 | } |
54 | |
a5871da3 |
55 | my $a; |
56 | $a = eval '$b = 0/0 if 0; 3'; |
a6d95d3b |
57 | is ($a, 3, 'constants in conditionals don\'t affect constant folding'); |
58 | is ($@, '', 'no error'); |
a5871da3 |
59 | |
60 | my $b = 0; |
61 | $a = eval 'if ($b) {return sqrt -3} 3'; |
a6d95d3b |
62 | is ($a, 3, 'variables in conditionals don\'t affect constant folding'); |
63 | is ($@, '', 'no error'); |
a5871da3 |
64 | |
65 | $a = eval q{ |
66 | $b = eval q{if ($b) {return log 0} 4}; |
a6d95d3b |
67 | is ($b, 4, 'inner eval folds constant'); |
68 | is ($@, '', 'no error'); |
a5871da3 |
69 | 5; |
70 | }; |
a6d95d3b |
71 | is ($a, 5, 'outer eval folds constant'); |
72 | is ($@, '', 'no error'); |
a5871da3 |
73 | |
5f2d9966 |
74 | # warn and die hooks should be disabled during constant folding |
75 | |
76 | { |
77 | my $c = 0; |
78 | local $SIG{__WARN__} = sub { $c++ }; |
79 | local $SIG{__DIE__} = sub { $c+= 2 }; |
80 | eval q{ |
81 | is($c, 0, "premature warn/die: $c"); |
82 | my $x = "a"+5; |
83 | is($c, 1, "missing warn hook"); |
84 | is($x, 5, "a+5"); |
85 | $c = 0; |
86 | $x = 1/0; |
87 | }; |
88 | like ($@, qr/division/, "eval caught division"); |
89 | is($c, 2, "missing die hook"); |
90 | } |