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, 2020 -- leonerd@leonerd.org.uk |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package Sub::Attribute::Prototype; |
7
|
|
|
|
|
|
|
|
8
|
3
|
|
|
3
|
|
139595
|
use strict; |
|
3
|
|
|
|
|
21
|
|
|
3
|
|
|
|
|
90
|
|
9
|
3
|
|
|
3
|
|
16
|
use warnings; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
702
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 NAME |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
C - polyfill for C<:prototype> attribute on older perls |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 SYNOPSIS |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
use Sub::Attribute::Prototype; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub afunc :prototype(&@) { |
22
|
|
|
|
|
|
|
... |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 DESCRIPTION |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
This polyfill allows a module to use the C<:prototype> function attribute to |
28
|
|
|
|
|
|
|
apply a prototype to a function, even on perls too old to natively support it. |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
Perl version 5.20 introduced the C<:prototype> attribute, as part of the wider |
31
|
|
|
|
|
|
|
work surrounding subroutine signatures. This allows a function to declare a |
32
|
|
|
|
|
|
|
prototype even when the C |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
If a newer version of perl switches the defaults to making signature syntax |
35
|
|
|
|
|
|
|
default, it will no longer be possible to write prototype-using functions |
36
|
|
|
|
|
|
|
using the old syntax, so authors will have to use C<:prototype> instead. By |
37
|
|
|
|
|
|
|
using this polyfill module, an author can ensure such syntax is still |
38
|
|
|
|
|
|
|
recognised by perl versions older than 5.20. |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
When used on a version of perl new enough to natively support the |
41
|
|
|
|
|
|
|
C<:prototype> attribute (i.e. 5.20 or newer), this module does nothing. Any |
42
|
|
|
|
|
|
|
C<:prototype> attribute syntax used by the user of this module is simply |
43
|
|
|
|
|
|
|
handled by core perl in the normal way. |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
When used on an older version of perl, a polyfilled compatibility attribute |
46
|
|
|
|
|
|
|
is provided to the caller to (mostly) perform the same work that newer |
47
|
|
|
|
|
|
|
versions of perl would do; subject to some caveats. |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head2 Caveats |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
The following caveats should be noted about the pre-5.20 polyfilled version |
52
|
|
|
|
|
|
|
of the C<:prototype> attribute. |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=over 4 |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=item * |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
Due to the way that attributes are applied to functions, it is not possible |
59
|
|
|
|
|
|
|
to apply the prototype immediately during compiletime. Instead, they must be |
60
|
|
|
|
|
|
|
deferred until a slightly later time. The earliest time that can feasibly be |
61
|
|
|
|
|
|
|
implemented is C time of the importing module. |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
This has the unfortunate downside that function prototypes are B visible |
64
|
|
|
|
|
|
|
to later functions in the module itself, though they are visible to the |
65
|
|
|
|
|
|
|
importing code in the usual way. This means that exported functions will work |
66
|
|
|
|
|
|
|
just fine from the perspective of a module that C |
67
|
|
|
|
|
|
|
used internally within the module itself. |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
Because this limitation only applies to the polyfilled version of the |
70
|
|
|
|
|
|
|
attribute for older versions of perl, it means the behavior will differ on a |
71
|
|
|
|
|
|
|
newer version of perl. Thus it is important that if you wish call a prototyped |
72
|
|
|
|
|
|
|
function from other parts of your module, you I use the |
73
|
|
|
|
|
|
|
prototype-defeating form of |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
my $result = &one_of_my_functions( @args ) |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
in order to get reliable behaviour between older and newer perl versions. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=item * |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
Perl versions older than 5.20 will provoke a warning in the C |
82
|
|
|
|
|
|
|
category when they encounter the attribute syntax provided by this polyfill, |
83
|
|
|
|
|
|
|
even though the polyfill has consumed the attribute. In order not to cause this |
84
|
|
|
|
|
|
|
warning to appear to users of modules using this syntax, it is necessary for |
85
|
|
|
|
|
|
|
this polyfill to suppress the entire C warning category. This means |
86
|
|
|
|
|
|
|
that all such warnings will be silenced, including those about different |
87
|
|
|
|
|
|
|
attributes. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=item * |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
Because core perl does not have a built-in way for exporter to inject a |
92
|
|
|
|
|
|
|
C block into their importer, it is necessary to use a non-core XS |
93
|
|
|
|
|
|
|
module, L, to provide this. As a result, this polyfill |
94
|
|
|
|
|
|
|
has non-core depenencies when running on older perl versions, and this |
95
|
|
|
|
|
|
|
dependency includes XS (i.e. compiled) code, and is no longer Pure Perl. It |
96
|
|
|
|
|
|
|
will not be possible to use tools such as L to bundle this |
97
|
|
|
|
|
|
|
dependency in order to ship a pure-perl portable script. |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=back |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
It should be stressed that none of these limitations apply when running on a |
102
|
|
|
|
|
|
|
version of perl 5.20 or later. Though in that case there is no need to use |
103
|
|
|
|
|
|
|
this polyfill at all, because the C<:prototype> attribute will be natively |
104
|
|
|
|
|
|
|
recognised. |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=cut |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub import |
109
|
|
|
|
|
|
|
{ |
110
|
|
|
|
|
|
|
# Perl 5.20 onwards already recognises a :prototype attribute, so we've |
111
|
|
|
|
|
|
|
# nothing to do |
112
|
3
|
50
|
|
3
|
|
223
|
return if $] >= 5.020; |
113
|
|
|
|
|
|
|
|
114
|
0
|
|
|
|
|
|
my $pkg = caller; |
115
|
|
|
|
|
|
|
|
116
|
0
|
|
|
|
|
|
require Sub::Util; Sub::Util->VERSION( '1.40' ); |
|
0
|
|
|
|
|
|
|
117
|
0
|
|
|
|
|
|
require B::CompilerPhase::Hook; |
118
|
|
|
|
|
|
|
|
119
|
0
|
|
|
|
|
|
my @prototypes; |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
my $MODIFY_CODE_ATTRIBUTES = sub { |
122
|
0
|
|
|
0
|
|
|
my ( $pkg, $code, @attrs ) = @_; |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
|
my @ret; |
125
|
0
|
|
|
|
|
|
foreach my $attr ( @attrs ) { |
126
|
0
|
0
|
|
|
|
|
if( $attr =~ m/^prototype\((.*)\)$/ ) { |
127
|
0
|
|
|
|
|
|
my $prototype = "$1"; |
128
|
0
|
|
|
|
|
|
push @prototypes, [ $code, $prototype ]; |
129
|
0
|
|
|
|
|
|
next; |
130
|
|
|
|
|
|
|
} |
131
|
0
|
|
|
|
|
|
push @ret, $attr; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
|
return @ret; |
135
|
0
|
|
|
|
|
|
}; |
136
|
3
|
|
|
3
|
|
20
|
{ no strict 'refs'; *{"${pkg}::MODIFY_CODE_ATTRIBUTES"} = $MODIFY_CODE_ATTRIBUTES } |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
575
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
B::CompilerPhase::Hook::enqueue_UNITCHECK( sub { |
139
|
0
|
|
|
0
|
|
|
foreach ( @prototypes ) { |
140
|
0
|
|
|
|
|
|
my ( $code, $prototype ) = @$_; |
141
|
0
|
|
|
|
|
|
Sub::Util::set_prototype( $_->[1], $_->[0] ); |
142
|
|
|
|
|
|
|
} |
143
|
0
|
|
|
|
|
|
} ); |
144
|
|
|
|
|
|
|
|
145
|
0
|
|
|
|
|
|
warnings->unimport( qw( reserved ) ); |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=head1 AUTHOR |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
Paul Evans |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=cut |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
0x55AA; |