This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #19078] wrong match order inside replacement
[perl5.git] / t / comp / fold.t
CommitLineData
2eaa2210
NC
1#!./perl -w
2
2eaa2210
NC
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
NC
7print "1..13\n";
8my $test = 0;
a5871da3
NC
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
NC
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
a5871da3
NC
55my $a;
56$a = eval '$b = 0/0 if 0; 3';
a6d95d3b
NC
57is ($a, 3, 'constants in conditionals don\'t affect constant folding');
58is ($@, '', 'no error');
a5871da3
NC
59
60my $b = 0;
61$a = eval 'if ($b) {return sqrt -3} 3';
a6d95d3b
NC
62is ($a, 3, 'variables in conditionals don\'t affect constant folding');
63is ($@, '', 'no error');
a5871da3
NC
64
65$a = eval q{
66 $b = eval q{if ($b) {return log 0} 4};
a6d95d3b
NC
67 is ($b, 4, 'inner eval folds constant');
68 is ($@, '', 'no error');
a5871da3
NC
69 5;
70};
a6d95d3b
NC
71is ($a, 5, 'outer eval folds constant');
72is ($@, '', 'no error');
a5871da3 73
5f2d9966
DM
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}