diff options
Diffstat (limited to 'lib/assertions.pm')
| -rw-r--r-- | lib/assertions.pm | 202 |
1 files changed, 174 insertions, 28 deletions
diff --git a/lib/assertions.pm b/lib/assertions.pm index 700abf46bb..0ced4bc228 100644 --- a/lib/assertions.pm +++ b/lib/assertions.pm @@ -1,6 +1,6 @@ package assertions; -our $VERSION = '0.01'; +our $VERSION = '0.02'; # use strict; # use warnings; @@ -8,22 +8,21 @@ our $VERSION = '0.01'; my $hint=0x01000000; my $seen_hint=0x02000000; -sub syntax_error ($$) { +sub _syntax_error ($$) { my ($expr, $why)=@_; require Carp; Carp::croak("syntax error on assertion filter '$expr' ($why)"); } -sub my_warn ($) { - my $error=shift; +sub _carp { require warnings; if (warnings::enabled('assertions')) { require Carp; - Carp::carp($error); + Carp::carp(@_); } } -sub calc_expr { +sub _calc_expr { my $expr=shift; my @tokens=split / \s* ( && # and @@ -49,38 +48,39 @@ sub calc_expr { else { if ($t eq '||') { defined $op[0] - and syntax_error $expr, 'consecutive operators'; + and _syntax_error $expr, 'consecutive operators'; $op[0]='||'; } elsif ($t eq '&&') { defined $op[0] - and syntax_error $expr, 'consecutive operators'; + and _syntax_error $expr, 'consecutive operators'; $op[0]='&&'; } else { if ($t eq ')') { @now==1 and - syntax_error $expr, 'unbalanced parens'; + _syntax_error $expr, 'unbalanced parens'; defined $op[0] and - syntax_error $expr, "key missing after operator '$op[0]'"; + _syntax_error $expr, "key missing after operator '$op[0]'"; $t=shift @now; shift @op; } elsif ($t eq '_') { unless ($^H & $seen_hint) { - my_warn "assertion status '_' referenced but not previously defined"; + _carp "assertion status '_' referenced but not previously defined"; } $t=($^H & $hint) ? 1 : 0; } elsif ($t ne '0' and $t ne '1') { - # print STDERR "'$t' resolved as "; - $t=grep ({ $t=~$_ } @{^ASSERTING}) ? 1 : 0; - # print STDERR "$t\n"; + $t = ( grep { ref $_ eq 'Regexp' + ? $t=~$_ + : $_->check($t) + } @{^ASSERTING} ) ? 1 : 0; } defined $op[0] or - syntax_error $expr, 'operator expected'; + _syntax_error $expr, 'operator expected'; if ($op[0] eq 'start') { $now[0]=$t; @@ -95,8 +95,8 @@ sub calc_expr { } } } - @now==1 or syntax_error $expr, 'unbalanced parens'; - defined $op[0] and syntax_error $expr, "expression ends on operator '$op[0]'"; + @now==1 or _syntax_error $expr, 'unbalanced parens'; + defined $op[0] and _syntax_error $expr, "expression ends on operator '$op[0]'"; return $now[0]; } @@ -107,7 +107,7 @@ sub import { shift; @_=(scalar(caller)) unless @_; foreach my $expr (@_) { - unless (calc_expr $expr) { + unless (_calc_expr $expr) { # print STDERR "assertions deactived"; $^H &= ~$hint; $^H |= $seen_hint; @@ -119,10 +119,38 @@ sub import { } sub unimport { + @_ > 1 + and _carp($_[0]."->unimport arguments are being ignored"); $^H &= ~$hint; } +sub enabled { + if (@_) { + if ($_[0]) { + $^H |= $hint; + } + else { + $^H &= ~$hint; + } + $^H |= $seen_hint; + } + return $^H & $hint ? 1 : 0; +} + +sub seen { + if (@_) { + if ($_[0]) { + $^H |= $seen_hint; + } + else { + $^H &= ~$seen_hint; + } + } + return $^H & $seen_hint ? 1 : 0; +} + 1; + __END__ @@ -148,7 +176,7 @@ assertions - select assertions in blocks of code } { - use assertions ' _ && bar '; + use assertions '_ && bar'; assert { print "asserting 'foo' && 'bar'\n" }; } @@ -160,17 +188,137 @@ The C<assertions> pragma specifies the tags used to enable and disable the execution of assertion subroutines. An assertion subroutine is declared with the C<:assertion> attribute. -This subroutine is not normally executed : it's optimized away by perl +This subroutine is not normally executed: it's optimized away by perl at compile-time. -The C<assertion> pragma associates to its lexical scope one or several -assertion tags. Then, to activate the execution of the assertions -subroutines in this scope, these tags must be given to perl via the -B<-A> command-line option. +The C<assertions> pragma associates to its lexical scope one or +several assertion tags. Then, to activate the execution of the +assertions subroutines in this scope, these tags must be given to perl +via the B<-A> command-line option. For instance, if... + + use assertions 'foobar'; + +is used, assertions on the same lexical scope will only be executed +when perl is called as... + + perl -A=foobar script.pl + +Regular expressions can also be used within the -A +switch. For instance... + + perl -A='foo.*' script.pl + +will activate assertions tagged as C<foo>, C<foobar>, C<foofoo>, etc. + +=head2 Selecting assertions + +Selecting which tags are required to activate assertions inside a +lexical scope, is done with the arguments passed on the C<use +assertions> sentence. + +If no arguments are given, the package name is used as the assertion tag: + + use assertions; + +is equivalent to + + use assertions __PACKAGE__; + +When several tags are given, all of them have to be activated via the +C<-A> switch to activate assertion execution on that lexical scope, +i.e.: + + use assertions qw(Foo Bar); + +Constants C<1> and C<0> can be used to force unconditional activation +or deactivation respectively: + + use assertions '0'; + use assertions '1'; + +Operators C<&&> and C<||> and parenthesis C<(...)> can be used to +construct logical expressions: + + use assertions 'foo && bar'; + use assertions 'foo || bar'; + use assertions 'foo && (bar || doz)'; + +(note that the logical operators and the parens have to be included +inside the quoted string). + +Finally, the special tag C<_> refers to the current assertion +activation state: + + use assertions 'foo'; + use assertions '_ && bar; + +is equivalent to + + use assertions 'foo && bar'; + +=head2 Handling assertions your own way + +The C<assertions> module also provides a set of low level functions to +allow for custom assertion handling modules. + +Those functions are not exported and have to be fully qualified with +the package name when called, for instance: + + require assertions; + assertions::enabled(1); + +(note that C<assertions> is loaded with the C<require> keyword +to avoid calling C<assertions::import()>). + +Those functions have to be called at compile time (they are +useless at runtime). + +=over 4 + +=item enabled($on) + +activates or deactivates assertion execution. For instance: + + package assertions::always; + + require assertions; + sub import { assertions::enabled(1) } + + 1; + +This function calls C<assertion::seen(1)> also (see below). + +=item enabled() + +returns a true value when assertion execution is active. + +=item seen($on) + +A warning is generated when an assertion subroutine is found before +any assertion selection code. This function is used to just tell perl +that assertion selection code has been seen and that the warning is +not required for the currently compiling lexical scope. + +=item seen() + +returns true if any assertion selection module (or code) has been +called before on the currently compiling lexical scope. + +=back + +=head1 COMPATIBILITY + +Support for assertions is only available in perl from version 5.9. On +previous perl versions this module will do nothing, though it will not +harm either. + +L<assertions::compat> provides an alternative way to use assertions +compatible with lower versions of perl. + =head1 SEE ALSO -L<perlrun>. +L<perlrun>, L<assertions::activate>, L<assertions::compat>. =head1 AUTHOR @@ -178,11 +326,9 @@ Salvador FandiE<ntilde>o, E<lt>sfandino@yahoo.comE<gt> =head1 COPYRIGHT AND LICENSE -Copyright 2002 by Salvador FandiE<ntilde>o +Copyright 2002, 2005 by Salvador FandiE<ntilde>o This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut - -TODO : Some more docs are to be added about assertion expressions. |