1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
#!./perl
BEGIN {
chdir 't';
@INC = '../lib';
require './test.pl';
}
plan tests => 7;
my @expect = qw(
b1
b2
b3
b4
b6-c
b7
u6
u5-c
u1
c3
c2-c
c1
i1
i2
b5
u2
u3
u4
b6-r
u5-r
e2
e1
);
my $expect = ":" . join(":", @expect);
fresh_perl_is(<<'SCRIPT', $expect,{switches => [''], stdin => '', stderr => 1 },'Order of execution of special blocks');
BEGIN {print ":b1"}
END {print ":e1"}
BEGIN {print ":b2"}
{
BEGIN {BEGIN {print ":b3"}; print ":b4"}
}
CHECK {print ":c1"}
INIT {print ":i1"}
UNITCHECK {print ":u1"}
eval 'BEGIN {print ":b5"}';
eval 'UNITCHECK {print ":u2"}';
eval 'UNITCHECK {print ":u3"; UNITCHECK {print ":u4"}}';
"a" =~ /(?{UNITCHECK {print ":u5-c"};
CHECK {print ":c2-c"};
BEGIN {print ":b6-c"}})/x;
{
use re 'eval';
my $runtime = q{
(?{UNITCHECK {print ":u5-r"};
CHECK {print ":c2-r"};
BEGIN {print ":b6-r"}})/
};
"a" =~ /$runtime/x;
}
eval {BEGIN {print ":b7"}};
eval {UNITCHECK {print ":u6"}};
eval {INIT {print ":i2"}};
eval {CHECK {print ":c3"}};
END {print ":e2"}
SCRIPT
@expect =(
# BEGIN
qw( main bar myfoo foo ),
# UNITCHECK
qw( foo myfoo bar main ),
# CHECK
qw( foo myfoo bar main ),
# INIT
qw( main bar myfoo foo ),
# END
qw(foo myfoo bar main ));
$expect = ":" . join(":", @expect);
fresh_perl_is(<<'SCRIPT2', $expect,{switches => [''], stdin => '', stderr => 1 },'blocks interact with packages/scopes');
BEGIN {$f = 'main'; print ":$f"}
UNITCHECK {print ":$f"}
CHECK {print ":$f"}
INIT {print ":$f"}
END {print ":$f"}
package bar;
BEGIN {$f = 'bar';print ":$f"}
UNITCHECK {print ":$f"}
CHECK {print ":$f"}
INIT {print ":$f"}
END {print ":$f"}
package foo;
{
my $f;
BEGIN {$f = 'myfoo'; print ":$f"}
UNITCHECK {print ":$f"}
CHECK {print ":$f"}
INIT {print ":$f"}
END {print ":$f"}
}
BEGIN {$f = "foo";print ":$f"}
UNITCHECK {print ":$f"}
CHECK {print ":$f"}
INIT {print ":$f"}
END {print ":$f"}
SCRIPT2
@expect = qw(begin unitcheck check init end);
$expect = ":" . join(":", @expect);
fresh_perl_is(<<'SCRIPT3', $expect,{switches => [''], stdin => '', stderr => 1 },'can name blocks as sub FOO');
sub BEGIN {print ":begin"}
sub UNITCHECK {print ":unitcheck"}
sub CHECK {print ":check"}
sub INIT {print ":init"}
sub END {print ":end"}
SCRIPT3
fresh_perl_is(<<'SCRIPT70614', "still here",{switches => [''], stdin => '', stderr => 1 },'eval-UNITCHECK-eval (bug 70614)');
eval "UNITCHECK { eval 0 }"; print "still here";
SCRIPT70614
# [perl #78634] Make sure block names can be used as constants.
use constant INIT => 5;
::is INIT, 5, 'constant named after a special block';
# [perl #108794] context
fresh_perl_is(<<'SCRIPT3', <<expEct,{stderr => 1 },'context');
sub context {
print qw[void scalar list][wantarray + defined wantarray], "\n"
}
BEGIN {context}
UNITCHECK {context}
CHECK {context}
INIT {context}
END {context}
SCRIPT3
void
void
void
void
void
expEct
fresh_perl_is('END { print "ok\n" } INIT { bless {} and exit }', "ok\n",
{}, 'null PL_curcop in newGP');
|
