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