extra code in pp_concat, Take 2
[p5sagit/p5-mst-13.2.git] / lib / assertions.pm
CommitLineData
06492da6 1package assertions;
2
3our $VERSION = '0.01';
4
5# use strict;
6# use warnings;
7
8my $hint=0x01000000;
8fa7688f 9my $seen_hint=0x02000000;
06492da6 10
8c63d938 11sub syntax_error ($$) {
12 my ($expr, $why)=@_;
13 require Carp;
14 Carp::croak("syntax error on assertion filter '$expr' ($why)");
15}
16
8fa7688f 17sub my_warn ($) {
18 my $error=shift;
19 require warnings;
20 if (warnings::enabled('assertions')) {
21 require Carp;
22 Carp::carp($error);
23 }
24}
25
8c63d938 26sub calc_expr {
27 my $expr=shift;
28 my @tokens=split / \s*
29 ( && # and
30 | \|\| # or
31 | \( # parents
32 | \) )
33 \s*
34 | \s+ # spaces out
35 /x, $expr;
36
37 # print STDERR "tokens: -", join('-',@tokens), "-\n";
38
39 my @now=1;
40 my @op='start';
41
42 for my $t (@tokens) {
8fa7688f 43 next if (!defined $t or $t eq '');
44
8c63d938 45 if ($t eq '(') {
46 unshift @now, 1;
47 unshift @op, 'start';
48 }
49 else {
50 if ($t eq '||') {
51 defined $op[0]
52 and syntax_error $expr, 'consecutive operators';
53 $op[0]='||';
54 }
55 elsif ($t eq '&&') {
56 defined $op[0]
57 and syntax_error $expr, 'consecutive operators';
58 $op[0]='&&';
59 }
8c63d938 60 else {
61 if ($t eq ')') {
62 @now==1 and
63 syntax_error $expr, 'unbalanced parens';
64 defined $op[0] and
65 syntax_error $expr, "key missing after operator '$op[0]'";
66
67 $t=shift @now;
68 shift @op;
69 }
70 elsif ($t eq '_') {
8fa7688f 71 unless ($^H & $seen_hint) {
72 my_warn "assertion status '_' referenced but not previously defined";
73 }
8c63d938 74 $t=($^H & $hint) ? 1 : 0;
75 }
76 elsif ($t ne '0' and $t ne '1') {
77 # print STDERR "'$t' resolved as ";
78 $t=grep ({ $t=~$_ } @{^ASSERTING}) ? 1 : 0;
79 # print STDERR "$t\n";
80 }
81
82 defined $op[0] or
83 syntax_error $expr, 'operator expected';
84
85 if ($op[0] eq 'start') {
86 $now[0]=$t;
87 }
88 elsif ($op[0] eq '||') {
89 $now[0]||=$t;
90 }
91 else {
92 $now[0]&&=$t;
93 }
94 undef $op[0];
95 }
96 }
97 }
98 @now==1 or syntax_error $expr, 'unbalanced parens';
99 defined $op[0] and syntax_error $expr, "expression ends on operator '$op[0]'";
100
101 return $now[0];
102}
103
104
06492da6 105sub import {
8c63d938 106 # print STDERR "\@_=", join("|", @_), "\n";
06492da6 107 shift;
108 @_=(scalar(caller)) unless @_;
8c63d938 109 foreach my $expr (@_) {
110 unless (calc_expr $expr) {
111 # print STDERR "assertions deactived";
06492da6 112 $^H &= ~$hint;
8fa7688f 113 $^H |= $seen_hint;
06492da6 114 return;
115 }
116 }
8c63d938 117 # print STDERR "assertions actived";
8fa7688f 118 $^H |= $hint|$seen_hint;
06492da6 119}
120
121sub unimport {
122 $^H &= ~$hint;
123}
124
1251;
126__END__
127
128
129=head1 NAME
130
702815ca 131assertions - select assertions in blocks of code
06492da6 132
133=head1 SYNOPSIS
134
135 sub assert (&) : assertion { &{$_[0]}() }
136
137 use assertions 'foo';
138 assert { print "asserting 'foo'\n" };
139
140 {
141 use assertions qw( foo bar );
702815ca 142 assert { print "asserting 'foo' and 'bar'\n" };
06492da6 143 }
144
145 {
146 use assertions qw( bar );
702815ca 147 assert { print "asserting only 'bar'\n" };
06492da6 148 }
149
150 {
8c63d938 151 use assertions ' _ && bar ';
152 assert { print "asserting 'foo' && 'bar'\n" };
06492da6 153 }
154
155 assert { print "asserting 'foo' again\n" };
156
06492da6 157=head1 DESCRIPTION
158
702815ca 159The C<assertions> pragma specifies the tags used to enable and disable
160the execution of assertion subroutines.
06492da6 161
702815ca 162An assertion subroutine is declared with the C<:assertion> attribute.
163This subroutine is not normally executed : it's optimized away by perl
164at compile-time.
06492da6 165
702815ca 166The C<assertion> pragma associates to its lexical scope one or several
167assertion tags. Then, to activate the execution of the assertions
168subroutines in this scope, these tags must be given to perl via the
169B<-A> command-line option.
06492da6 170
171=head1 SEE ALSO
172
702815ca 173L<perlrun>.
06492da6 174
175=head1 AUTHOR
176
c54bef43 177Salvador FandiE<ntilde>o, E<lt>sfandino@yahoo.comE<gt>
06492da6 178
179=head1 COPYRIGHT AND LICENSE
180
c54bef43 181Copyright 2002 by Salvador FandiE<ntilde>o
06492da6 182
183This library is free software; you can redistribute it and/or modify
184it under the same terms as Perl itself.
185
186=cut
702815ca 187
188TODO : Some more docs are to be added about assertion expressions.