line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# You may distribute under the terms of either the GNU General Public License |
2
|
|
|
|
|
|
|
# or the Artistic License (the same terms as Perl itself) |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# (C) Paul Evans, 2021-2022 -- leonerd@leonerd.org.uk |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package Syntax::Keyword::Defer 0.10; |
7
|
|
|
|
|
|
|
|
8
|
6
|
|
|
6
|
|
1212489
|
use v5.14; |
|
6
|
|
|
|
|
54
|
|
9
|
6
|
|
|
6
|
|
33
|
use warnings; |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
148
|
|
10
|
|
|
|
|
|
|
|
11
|
6
|
|
|
6
|
|
32
|
use Carp; |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
3139
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our @CARP_NOT = qw( Syntax::Keyword::Finally ); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
require XSLoader; |
16
|
|
|
|
|
|
|
XSLoader::load( __PACKAGE__, our $VERSION ); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 NAME |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
C - execute code when leaving a block |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 SYNOPSIS |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
use Syntax::Keyword::Defer; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
{ |
27
|
|
|
|
|
|
|
my $dbh = DBI->connect( ... ) or die "Cannot connect"; |
28
|
|
|
|
|
|
|
defer { $dbh->disconnect; } |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
my $sth = $dbh->prepare( ... ) or die "Cannot prepare"; |
31
|
|
|
|
|
|
|
defer { $sth->finish; } |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
... |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 DESCRIPTION |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
This module provides a syntax plugin that implements a block which executes |
39
|
|
|
|
|
|
|
when the containing scope has finished. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
It similar to features provided by other languages; Swift, Zig, Jai, Nim and |
42
|
|
|
|
|
|
|
Odin all provide this. Note that while Go also provides a C keyword, |
43
|
|
|
|
|
|
|
the semantics here are not the same. Go's version defers until the end of the |
44
|
|
|
|
|
|
|
entire function, rather than the closest enclosing scope as is common to most |
45
|
|
|
|
|
|
|
other languages, and this module. |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
The operation can be considered a little similar to an C block, but with |
48
|
|
|
|
|
|
|
the following key differences: |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=over 2 |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=item * |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
A C block runs at the time that execution leaves the block it is |
55
|
|
|
|
|
|
|
declared inside, whereas an C block runs at the end time of the entire |
56
|
|
|
|
|
|
|
program regardless of its location. |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=item * |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
A C block is invoked at the time its containing scope has finished, |
61
|
|
|
|
|
|
|
which means it might run again if the block is entered again later in the |
62
|
|
|
|
|
|
|
program. An C block will only ever run once. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=item * |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
A C block will only take effect if execution reaches the line it is |
67
|
|
|
|
|
|
|
declared on; if the line is not reached then nothing happens. An C block |
68
|
|
|
|
|
|
|
will always be invoked once declared, regardless of the dynamic extent of |
69
|
|
|
|
|
|
|
execution at runtime. |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=back |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
C blocks are primarily intended for cases such as resource finalisation |
74
|
|
|
|
|
|
|
tasks that may be conditionally required. |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
For example in the synopsis code, after normal execution the statement handle |
77
|
|
|
|
|
|
|
will be finished using the C<< $sth->finish >> method, then the database will |
78
|
|
|
|
|
|
|
be disconnected with C<< $dbh->disconnect >>. If instead the prepare method |
79
|
|
|
|
|
|
|
failed then the database will still be disconnected, but there is no need to |
80
|
|
|
|
|
|
|
finish with the statement handle as the second C block was never |
81
|
|
|
|
|
|
|
encountered. |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=cut |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=head1 KEYWORDS |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=head2 defer |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
defer { |
90
|
|
|
|
|
|
|
STATEMENTS... |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
The C keyword introduces a block which runs its code body at the time |
94
|
|
|
|
|
|
|
that its immediately surrounding code block finishes. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
When the C statement is encountered, the body of the code block is |
97
|
|
|
|
|
|
|
pushed to a queue of pending operations, which is then flushed when the |
98
|
|
|
|
|
|
|
surrounding block finishes for any reason - either by implicit fallthrough, |
99
|
|
|
|
|
|
|
or explicit termination by C, C or any of the loop control |
100
|
|
|
|
|
|
|
statements C, C or C. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub f |
103
|
|
|
|
|
|
|
{ |
104
|
|
|
|
|
|
|
defer { say "The function has now returned"; } |
105
|
|
|
|
|
|
|
return 123; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
If multiple C statements appear within the same block, they are pushed |
109
|
|
|
|
|
|
|
to the queue in LIFO order; the last one encountered is the first one to be |
110
|
|
|
|
|
|
|
executed. |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
{ |
113
|
|
|
|
|
|
|
defer { say "This happens second"; } |
114
|
|
|
|
|
|
|
defer { say "This happens first"; } |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
A C block will only take effect if the statement itself is actually |
118
|
|
|
|
|
|
|
encountered during normal execution. This is in direct contrast to an C |
119
|
|
|
|
|
|
|
phaser which always occurs. This makes it ideal for handling finalisation of a |
120
|
|
|
|
|
|
|
resource which was created on a nearby previous line, where the code to create |
121
|
|
|
|
|
|
|
it might have thrown an exception instead. Because the exception skipped over |
122
|
|
|
|
|
|
|
the C statement, the code body does not need to run. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
my $resource = Resource->open( ... ); |
125
|
|
|
|
|
|
|
defer { $resource->close; } |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
Unlike as would happen with e.g. a C method on a guard object, any |
128
|
|
|
|
|
|
|
exceptions thrown from a C block are still propagated up to the caller |
129
|
|
|
|
|
|
|
in the usual way. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
use Syntax::Keyword::Defer; |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub f |
134
|
|
|
|
|
|
|
{ |
135
|
|
|
|
|
|
|
my $count = 0; |
136
|
|
|
|
|
|
|
defer { $count or die "Failed to increment count"; } |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# some code here |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
f(); |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
Z<> |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
$ perl example.pl |
146
|
|
|
|
|
|
|
Failed to increment count at examples.pl line 6. |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
However, if a C block is being run because of exceptional return of its |
149
|
|
|
|
|
|
|
scope, any further exceptions it attempts to raise are turned into warnings. |
150
|
|
|
|
|
|
|
This ensures that the original exception which caused the stack-unwind to run |
151
|
|
|
|
|
|
|
the block in the first place does not get overwritten on the way. |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
Because a C block is a true block (e.g. in the same way something like |
154
|
|
|
|
|
|
|
an C block is), rather than an anonymous sub, it does not appear |
155
|
|
|
|
|
|
|
to C or other stack-inspection tricks. This is useful for calling |
156
|
|
|
|
|
|
|
C, for example. |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub g |
159
|
|
|
|
|
|
|
{ |
160
|
|
|
|
|
|
|
my $count = 0; |
161
|
|
|
|
|
|
|
defer { $count or croak "Expected some items"; } |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
$count++ for @_; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
Here, C will correctly report the caller of the C function, |
167
|
|
|
|
|
|
|
rather than appearing to be called from an C<__ANON__> sub invoked at the end |
168
|
|
|
|
|
|
|
of the function itself. |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=cut |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
sub import |
173
|
|
|
|
|
|
|
{ |
174
|
3
|
|
|
3
|
|
23
|
my $pkg = shift; |
175
|
3
|
|
|
|
|
7
|
my $caller = caller; |
176
|
|
|
|
|
|
|
|
177
|
3
|
|
|
|
|
10
|
$pkg->import_into( $caller, @_ ); |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub unimport |
181
|
|
|
|
|
|
|
{ |
182
|
1
|
|
|
1
|
|
11
|
my $pkg = shift; |
183
|
1
|
|
|
|
|
2
|
my $caller = caller; |
184
|
|
|
|
|
|
|
|
185
|
1
|
|
|
|
|
4
|
$pkg->unimport_into( $caller, @_ ); |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
|
188
|
3
|
|
|
3
|
0
|
20
|
sub import_into { shift->apply( sub { $^H{ $_[0] }++ }, @_ ) } |
|
3
|
|
|
3
|
|
15
|
|
189
|
1
|
|
|
1
|
0
|
6
|
sub unimport_into { shift->apply( sub { delete $^H{ $_[0] } }, @_ ) } |
|
1
|
|
|
1
|
|
5
|
|
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
sub apply |
192
|
|
|
|
|
|
|
{ |
193
|
4
|
|
|
4
|
0
|
8
|
my $pkg = shift; |
194
|
4
|
|
|
|
|
9
|
my ( $cb, $caller, @syms ) = @_; |
195
|
|
|
|
|
|
|
|
196
|
4
|
50
|
|
|
|
18
|
@syms or @syms = qw( defer ); |
197
|
|
|
|
|
|
|
|
198
|
4
|
|
|
|
|
10
|
my %syms = map { $_ => 1 } @syms; |
|
4
|
|
|
|
|
14
|
|
199
|
4
|
50
|
|
|
|
24
|
$cb->( "Syntax::Keyword::Defer/defer" ) if delete $syms{defer}; |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
croak "'FINALLY' has now been removed; use 'defer' instead" and $cb->( "Syntax::Keyword::Defer/finally" ) |
202
|
4
|
50
|
0
|
|
|
13
|
if delete $syms{finally}; |
203
|
|
|
|
|
|
|
|
204
|
4
|
50
|
|
|
|
7733
|
croak "Unrecognised import symbols @{[ keys %syms ]}" if keys %syms; |
|
0
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=head1 TODO |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
This module contains a unit test file copied and edited from my core perl |
210
|
|
|
|
|
|
|
branch to provide the same syntax. Several test cases are currently commented |
211
|
|
|
|
|
|
|
out because this implementation does not yet handle them: |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=over 4 |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=item * |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
Detection logic of defer-during-throw is currently based on the truth of the |
218
|
|
|
|
|
|
|
C (C<$@>), which means it is liable to false positives. There may not |
219
|
|
|
|
|
|
|
be much that can be done about this. |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=item * |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
Try to fix the double-exception test failure on Perl versions before v5.20. |
224
|
|
|
|
|
|
|
(Test currently skipped on those versions) |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=item * |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
Try to detect and forbid nonlocal flow control (C, C) |
229
|
|
|
|
|
|
|
from leaving the C block. |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
E.g. currently the following will crash the interpreter: |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
sub func { last ITEM } |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
ITEM: foreach(1..10) { |
236
|
|
|
|
|
|
|
say; |
237
|
|
|
|
|
|
|
defer { func() } |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=back |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=cut |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=head1 AUTHOR |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
Paul Evans |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=cut |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
0x55AA; |