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