Commit | Line | Data |
aefc56c5 |
1 | package assertions::compat; |
2 | |
3 | require assertions; |
4 | our @ISA = qw(assertions); |
5 | |
6 | sub _on () { 1 } |
7 | sub _off () { 0 } |
8 | |
9 | sub import { |
10 | my $class = shift; |
11 | my $name = @_ ? shift : 'asserting'; |
12 | my $pkg = caller; |
13 | $name =~ /::/ or $name = "${pkg}::${name}"; |
14 | @_ = $pkg unless @_; |
15 | $class->SUPER::import(@_); |
16 | my $enabled = assertions::enabled(); |
17 | { |
18 | no strict 'vars'; |
19 | no warnings; |
20 | undef &{$name}; |
21 | *{$name} = $enabled ? \&_on : \&_off; |
22 | } |
23 | } |
24 | |
25 | sub _compat_assertion_handler { |
26 | shift; shift; |
27 | grep $_ ne 'assertion', @_ |
28 | } |
29 | |
30 | sub _do_nothing_handler {} |
31 | |
32 | # test if 'assertion' attribute is natively supported |
33 | my $assertion_ok=eval q{ |
34 | sub _my_asserting_test : assertion { 1 } |
35 | _my_asserting_test() |
36 | }; |
37 | |
38 | *MODIFY_CODE_ATTRIBUTES = |
39 | defined($assertion_ok) |
40 | ? \&_do_nothing_handler |
41 | : \&_compat_assertion_handler; |
42 | |
43 | 1; |
44 | |
45 | __END__ |
46 | |
47 | =head1 NAME |
48 | |
49 | assertions::compat - assertions for pre-5.9 versions of perl |
50 | |
51 | =head1 SYNOPSIS |
52 | |
53 | # add support for 'assertion' attribute: |
54 | use base 'assertions::compat'; |
55 | sub assert_foo : assertion { ... }; |
56 | |
57 | # then, maybe in another module: |
58 | package Foo::Bar; |
59 | |
60 | # define sub 'asserting' with the assertion status: |
61 | use assertions::compat; |
62 | asserting and assert_foo(1,2,3,4); |
63 | |
64 | # or |
65 | use assertions::compat ASST => 'Foo::Bar::doz'; |
66 | ASST and assert_foo('dozpera'); |
67 | |
68 | =head1 DESCRIPTION |
69 | |
70 | C<assertions::compat> allows to use assertions on perl versions prior |
71 | to 5.9.0 (that is the first one to natively support them). Though, |
72 | it's not magic, do not expect it to allow for conditional executed |
73 | subroutines. |
74 | |
75 | This module provides support for two different functionalities: |
76 | |
77 | =head2 The C<assertion> attribute handler |
78 | |
79 | The subroutine attribute C<assertion> is not recognised on perls |
80 | without assertion support. This module provides a |
81 | C<MODIFY_CODE_ATTRIBUTES> handler for this attribute. It must be used |
82 | via inheritance: |
83 | |
84 | use base 'assertions::compat'; |
85 | |
86 | sub assert_foo : assertion { ... } |
87 | |
88 | Be aware that the handler just discards the attribute, so subroutines |
89 | declared as assertions will be B<unconditionally> called on perl without |
90 | native support for them. |
91 | |
92 | =head2 Assertion execution status as a constant |
93 | |
94 | C<assertions::compat> also allows to create constant subs which value |
95 | is the assertion execution status. That allows checking explicitly and |
96 | efficiently if assertions have to be executed on perls without native |
97 | assertion support. |
98 | |
99 | For instance... |
100 | |
101 | use assertions::compat ASST => 'Foo::Bar'; |
102 | |
103 | exports constant subroutine C<ASST>. Its value is true when assertions |
104 | tagged as C<Foo::Bar> has been activated via L<assertions::activate>; |
105 | usually done with the -A switch from the command line on perls |
106 | supporting it... |
107 | |
108 | perl -A=Foo::Bar my_script.pl |
109 | |
110 | or alternatively with... |
111 | |
112 | perl -Massertions::activate=Foo::Bar my_script.pl |
113 | |
114 | on pre-5.9.0 versions of perl. |
115 | |
116 | The constant sub defined can be used following this idiom: |
117 | |
118 | use assertions::compat ASST => 'Foo::Bar'; |
119 | ... |
120 | ASST and assert_foo(); |
121 | |
122 | When ASST is false, the perl interpreter optimizes away the rest of |
123 | the C<and> statement at compile time. |
124 | |
125 | |
126 | When no assertion selection tags are passed to C<use |
127 | assertions::compat>, the current module name is used as the selection |
128 | tag, so... |
129 | |
130 | use assertions::compat 'ASST'; |
131 | |
132 | is equivalent to... |
133 | |
134 | use assertions::compat ASST => __PACKAGE__; |
135 | |
136 | If the name of the constant subroutine is also omitted, C<asserting> |
137 | is used. |
138 | |
139 | This module will not emit a warning when the constant is redefined. |
140 | this is done on purpose to allow for code like that: |
141 | |
142 | use assertions::compat ASST => 'Foo'; |
143 | ASST and assert_foo(); |
144 | |
145 | use assertions::compat ASST => 'Bar'; |
146 | ASST and assert_bar(); |
147 | |
148 | Finally, be aware that while assertion execution status is lexical |
149 | scoped, defined constants are not. You should be careful on that to |
150 | not write inconsistent code. For instance... |
151 | |
152 | package Foo; |
153 | |
154 | use MyAssertions qw(assert_foo); |
155 | |
156 | use assertions::compat ASST => 'Foo::Out' |
157 | { |
158 | use assertions::compat ASST => 'Foo::In'; |
159 | ASST and assert_foo(); # ok! |
160 | } |
161 | |
162 | ASST and assert_foo() # bad usage! |
163 | # ASST refers to tag Foo::In while assert_foo() is |
164 | # called only when Foo::Out has been activated. |
165 | # This is not what you want!!! |
166 | |
167 | |
168 | =head1 SEE ALSO |
169 | |
170 | L<perlrun>, L<assertions>, L<assertions::activate>, L<attributes>. |
171 | |
172 | =head1 AUTHOR |
173 | |
174 | Salvador FandiE<ntilde>o, E<lt>sfandino@yahoo.comE<gt> |
175 | |
176 | =head1 COPYRIGHT AND LICENSE |
177 | |
178 | Copyright 2005 by Salvador FandiE<ntilde>o |
179 | |
180 | This library is free software; you can redistribute it and/or modify |
181 | it under the same terms as Perl itself. |
182 | |
183 | =cut |