1#!./perl -w 2 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; 6 7print "1..13\n"; 8my $test = 0; 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 17 18sub 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 33sub 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 45sub 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 55my $a; 56$a = eval '$b = 0/0 if 0; 3'; 57is ($a, 3, 'constants in conditionals don\'t affect constant folding'); 58is ($@, '', 'no error'); 59 60my $b = 0; 61$a = eval 'if ($b) {return sqrt -3} 3'; 62is ($a, 3, 'variables in conditionals don\'t affect constant folding'); 63is ($@, '', 'no error'); 64 65$a = eval q{ 66 $b = eval q{if ($b) {return log 0} 4}; 67 is ($b, 4, 'inner eval folds constant'); 68 is ($@, '', 'no error'); 69 5; 70}; 71is ($a, 5, 'outer eval folds constant'); 72is ($@, '', 'no error'); 73 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} 91