This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Don't use require in comp/fold.t, as require isn't tested yet.
[perl5.git] / t / comp / fold.t
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
7 print "1..13\n";
8 my $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
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
55 my $a;
56 $a = eval '$b = 0/0 if 0; 3';
57 is ($a, 3, 'constants in conditionals don\'t affect constant folding');
58 is ($@, '', 'no error');
59
60 my $b = 0;
61 $a = eval 'if ($b) {return sqrt -3} 3';
62 is ($a, 3, 'variables in conditionals don\'t affect constant folding');
63 is ($@, '', '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 };
71 is ($a, 5, 'outer eval folds constant');
72 is ($@, '', '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 }