xref: /openbsd/gnu/usr.bin/perl/t/op/blocks.t (revision 5af055cd)
1#!./perl
2
3BEGIN {
4    chdir 't';
5    @INC = '../lib';
6    require './test.pl';
7}
8
9plan tests => 7;
10
11my @expect = qw(
12b1
13b2
14b3
15b4
16b6-c
17b7
18u6
19u5-c
20u1
21c3
22c2-c
23c1
24i1
25i2
26b5
27u2
28u3
29u4
30b6-r
31u5-r
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"}}';
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}
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
119
120fresh_perl_is(<<'SCRIPT70614', "still here",{switches => [''], stdin => '', stderr => 1 },'eval-UNITCHECK-eval (bug 70614)');
121eval "UNITCHECK { eval 0 }"; print "still here";
122SCRIPT70614
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';
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
145
146fresh_perl_is('END { print "ok\n" } INIT { bless {} and exit }', "ok\n",
147	       {}, 'null PL_curcop in newGP');
148