This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
sort perldiag
[perl5.git] / t / op / blocks.t
CommitLineData
3c10abe3
AG
1#!./perl
2
3BEGIN {
a817e89d 4 chdir 't' if -d 't';
3c10abe3 5 require './test.pl';
43ece5b1 6 set_up_inc('../lib');
3c10abe3
AG
7}
8
9e14fb1f 9plan tests => 11;
3c10abe3
AG
10
11my @expect = qw(
12b1
13b2
14b3
15b4
68e2671b 16b6-c
3c10abe3
AG
17b7
18u6
68e2671b 19u5-c
3c10abe3
AG
20u1
21c3
68e2671b 22c2-c
3c10abe3
AG
23c1
24i1
25i2
26b5
27u2
28u3
29u4
68e2671b
DM
30b6-r
31u5-r
3c10abe3
AG
32e2
33e1
34 );
35my $expect = ":" . join(":", @expect);
36
37fresh_perl_is(<<'SCRIPT', $expect,{switches => [''], stdin => '', stderr => 1 },'Order of execution of special blocks');
38BEGIN {print ":b1"}
39END {print ":e1"}
40BEGIN {print ":b2"}
41{
42 BEGIN {BEGIN {print ":b3"}; print ":b4"}
43}
44CHECK {print ":c1"}
45INIT {print ":i1"}
46UNITCHECK {print ":u1"}
47eval 'BEGIN {print ":b5"}';
48eval 'UNITCHECK {print ":u2"}';
49eval 'UNITCHECK {print ":u3"; UNITCHECK {print ":u4"}}';
68e2671b
DM
50"a" =~ /(?{UNITCHECK {print ":u5-c"};
51 CHECK {print ":c2-c"};
52 BEGIN {print ":b6-c"}})/x;
53{
54 use re 'eval';
55 my $runtime = q{
56 (?{UNITCHECK {print ":u5-r"};
57 CHECK {print ":c2-r"};
58 BEGIN {print ":b6-r"}})/
59 };
60 "a" =~ /$runtime/x;
61}
3c10abe3
AG
62eval {BEGIN {print ":b7"}};
63eval {UNITCHECK {print ":u6"}};
64eval {INIT {print ":i2"}};
65eval {CHECK {print ":c3"}};
66END {print ":e2"}
67SCRIPT
68
69@expect =(
70# BEGIN
71qw( main bar myfoo foo ),
72# UNITCHECK
73qw( foo myfoo bar main ),
74# CHECK
75qw( foo myfoo bar main ),
76# INIT
77qw( main bar myfoo foo ),
78# END
79qw(foo myfoo bar main ));
80
81$expect = ":" . join(":", @expect);
82fresh_perl_is(<<'SCRIPT2', $expect,{switches => [''], stdin => '', stderr => 1 },'blocks interact with packages/scopes');
83BEGIN {$f = 'main'; print ":$f"}
84UNITCHECK {print ":$f"}
85CHECK {print ":$f"}
86INIT {print ":$f"}
87END {print ":$f"}
88package bar;
89BEGIN {$f = 'bar';print ":$f"}
90UNITCHECK {print ":$f"}
91CHECK {print ":$f"}
92INIT {print ":$f"}
93END {print ":$f"}
94package foo;
95{
96 my $f;
97 BEGIN {$f = 'myfoo'; print ":$f"}
98 UNITCHECK {print ":$f"}
99 CHECK {print ":$f"}
100 INIT {print ":$f"}
101 END {print ":$f"}
102}
103BEGIN {$f = "foo";print ":$f"}
104UNITCHECK {print ":$f"}
105CHECK {print ":$f"}
106INIT {print ":$f"}
107END {print ":$f"}
108SCRIPT2
109
110@expect = qw(begin unitcheck check init end);
111$expect = ":" . join(":", @expect);
112fresh_perl_is(<<'SCRIPT3', $expect,{switches => [''], stdin => '', stderr => 1 },'can name blocks as sub FOO');
113sub BEGIN {print ":begin"}
114sub UNITCHECK {print ":unitcheck"}
115sub CHECK {print ":check"}
116sub INIT {print ":init"}
117sub END {print ":end"}
118SCRIPT3
8ed49485
FC
119
120fresh_perl_is(<<'SCRIPT70614', "still here",{switches => [''], stdin => '', stderr => 1 },'eval-UNITCHECK-eval (bug 70614)');
121eval "UNITCHECK { eval 0 }"; print "still here";
122SCRIPT70614
75bd28cf
FC
123
124# [perl #78634] Make sure block names can be used as constants.
125use constant INIT => 5;
126::is INIT, 5, 'constant named after a special block';
9a8aa25b
FC
127
128# [perl #108794] context
129fresh_perl_is(<<'SCRIPT3', <<expEct,{stderr => 1 },'context');
130sub context {
131 print qw[void scalar list][wantarray + defined wantarray], "\n"
132}
133BEGIN {context}
134UNITCHECK {context}
135CHECK {context}
136INIT {context}
137END {context}
138SCRIPT3
139void
140void
141void
142void
143void
144expEct
c947bc1d
FC
145
146fresh_perl_is('END { print "ok\n" } INIT { bless {} and exit }', "ok\n",
147 {}, 'null PL_curcop in newGP');
05e36430
DC
148
149fresh_perl_is('BEGIN{exit 0}; print "still here"', '', {}, 'RT #2754: BEGIN{exit 0} should exit');
150TODO: {
151 local $TODO = 'RT #2754: CHECK{exit 0} is broken';
152 fresh_perl_is('CHECK{exit 0}; print "still here"', '', {}, 'RT #2754: CHECK{exit 0} should exit');
153}
a5fd18fc
DC
154
155TODO: {
156 local $TODO = 'RT #2917: INIT{} in eval is wrongly considered too late';
157 fresh_perl_is('eval "INIT { print qq(in init); };";', 'in init', {}, 'RT #2917: No constraint on how late INIT blocks can run');
158}
9e14fb1f
DC
159
160fresh_perl_is('eval "BEGIN {goto end}"; end:', '', {}, 'RT #113934: goto out of BEGIN causes assertion failure');
161