From: Salvador Fandiño Date: Tue, 18 Feb 2003 19:24:13 +0000 (+0000) Subject: more complex assertions activation: X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8c63d93843745ff8766bc75490d35dc2b080c5c0;p=p5sagit%2Fp5-mst-13.2.git more complex assertions activation: Subject: Re: Did the assertion patch/feature submission get overlooked? Message-ID: <3E52885D.5060903@yahoo.com> p4raw-id: //depot/perl@18750 --- diff --git a/lib/assertions.pm b/lib/assertions.pm index 8369b74..918808d 100644 --- a/lib/assertions.pm +++ b/lib/assertions.pm @@ -7,24 +7,107 @@ our $VERSION = '0.01'; my $hint=0x01000000; +sub syntax_error ($$) { + my ($expr, $why)=@_; + require Carp; + Carp::croak("syntax error on assertion filter '$expr' ($why)"); +} + +sub calc_expr { + my $expr=shift; + my @tokens=split / \s* + ( && # and + | \|\| # or + | \( # parents + | \) ) + \s* + | \s+ # spaces out + /x, $expr; + + # print STDERR "tokens: -", join('-',@tokens), "-\n"; + + my @now=1; + my @op='start'; + + for my $t (@tokens) { + if ($t eq '(') { + unshift @now, 1; + unshift @op, 'start'; + } + else { + if ($t eq '||') { + defined $op[0] + and syntax_error $expr, 'consecutive operators'; + $op[0]='||'; + } + elsif ($t eq '&&') { + defined $op[0] + and syntax_error $expr, 'consecutive operators'; + $op[0]='&&'; + } + elsif (!defined $t or $t eq '') { + # warn "empty token"; + } + else { + if ($t eq ')') { + @now==1 and + syntax_error $expr, 'unbalanced parens'; + defined $op[0] and + syntax_error $expr, "key missing after operator '$op[0]'"; + + $t=shift @now; + shift @op; + } + elsif ($t eq '_') { + $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"; + } + + defined $op[0] or + syntax_error $expr, 'operator expected'; + + if ($op[0] eq 'start') { + $now[0]=$t; + } + elsif ($op[0] eq '||') { + $now[0]||=$t; + } + else { + $now[0]&&=$t; + } + undef $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]; +} + + sub import { + # print STDERR "\@_=", join("|", @_), "\n"; shift; @_=(scalar(caller)) unless @_; - - if ($_[0] eq '&') { - return unless $^H & $hint; - shift; - } - - for my $tag (@_) { - unless (grep { $tag=~$_ } @{^ASSERTING}) { + foreach my $expr (@_) { + unless (calc_expr $expr) { + # print STDERR "assertions deactived"; $^H &= ~$hint; return; } } + # print STDERR "assertions actived"; $^H |= $hint; } + + + sub unimport { $^H &= ~$hint; } @@ -55,8 +138,8 @@ assertions - selects assertions } { - use assertions qw( & bar ); - assert { print "asserting 'foo' & 'bar'\n" }; + use assertions ' _ && bar '; + assert { print "asserting 'foo' && 'bar'\n" }; } assert { print "asserting 'foo' again\n" }; diff --git a/lib/assertions/activate.pm b/lib/assertions/activate.pm index 6f0f37e..f3abd1e 100644 --- a/lib/assertions/activate.pm +++ b/lib/assertions/activate.pm @@ -7,6 +7,7 @@ our $VERSION = '0.01'; sub import { shift; + @_='.*' unless @_; push @{^ASSERTING}, ( map { qr/^$_$/ } @_) ; } diff --git a/t/comp/assertions.t b/t/comp/assertions.t index d3d9783..da9f568 100644 --- a/t/comp/assertions.t +++ b/t/comp/assertions.t @@ -1,16 +1,72 @@ #!./perl +sub callme ($ ) : assertion { + return shift; +} + +# select STDERR; $|=1; + +my @expr=( '1' => 1, + '0' => 0, + '1 && 1' => 1, + '1 && 0' => 0, + '0 && 1' => 0, + '0 && 0' => 0, + '1 || 1' => 1, + '1 || 0' => 1, + '0 || 1' => 1, + '0 || 0' => 0, + '(1)' => 1, + '(0)' => 0, + '1 && ((1) && 1)' => 1, + '1 && (0 || 1)' => 1, + '1 && ( 0' => undef, + '1 &&' => undef, + '&& 1' => undef, + '1 && || 1' => undef, + '(1 && 1) && 1)' => undef, + 'one && two' => 1, + '_ && one' => 0, + 'one && three' => 0, + '1 ' => 1, + ' 1' => 1, + ' 1 ' => 1, + ' ( 1 && 1 ) ' => 1, + ' ( 1 && 0 ) ' => 0, + '(( 1 && 1) && ( 1 || 0)) || _ && one && ( one || three)' => 1 ); + +my $n=@expr/2+10; my $i=1; -print "1..10\n"; +print "1..$n\n"; -sub callme ($) : assertion { - return shift; +use assertions::activate 'one', 'two'; +require assertions; + +while (@expr) { + my $expr=shift @expr; + my $expected=shift @expr; + my $result=eval {assertions::calc_expr($expr)}; + if (defined $expected) { + unless (defined $result and $result == $expected) { + print STDERR "assertions::calc_expr($expr) failed,". + " expected '$expected' but '$result' obtained (\$@=$@)\n"; + print "not "; + } + } + else { + if (defined $result) { + print STDERR "assertions::calc_expr($expr) failed,". + " expected undef but '$result' obtained\n"; + print "not "; + } + } + print "ok ", $i++, "\n"; } -# 1 +# @expr/2+1 if (callme(1)) { - print STDERR "assertions called by default"; + print STDERR "assertions called by default\n"; print "not "; } print "ok ", $i++, "\n"; @@ -24,7 +80,7 @@ use assertions::activate 'mine'; } use assertions; unless (callme(1)) { - print STDERR "'use assertions;' doesn't active assertions based on package name"; + print STDERR "'use assertions;' doesn't active assertions based on package name\n"; print "not "; } } @@ -33,7 +89,7 @@ print "ok ", $i++, "\n"; # 3 use assertions 'foo'; if (callme(1)) { - print STDERR "assertion deselection doesn't work"; + print STDERR "assertion deselection doesn't work\n"; print "not "; } print "ok ", $i++, "\n"; @@ -42,23 +98,23 @@ print "ok ", $i++, "\n"; use assertions::activate 'bar', 'doz'; use assertions 'bar'; unless (callme(1)) { - print STDERR "assertion selection doesn't work"; + print STDERR "assertion selection doesn't work\n"; print "not "; } print "ok ", $i++, "\n"; # 5 -use assertions '&', 'doz'; +use assertions q(_ && doz); unless (callme(1)) { - print STDERR "assertion activation filtering doesn't work"; + print STDERR "assertion activation filtering doesn't work\n"; print "not "; } print "ok ", $i++, "\n"; # 6 -use assertions '&', 'foo'; +use assertions q(_ && foo); if (callme(1)) { - print STDERR "assertion deactivation filtering doesn't work"; + print STDERR "assertion deactivation filtering doesn't work\n"; print "not "; } print "ok ", $i++, "\n"; @@ -68,7 +124,7 @@ if (1) { use assertions 'bar'; } if (callme(1)) { - print STDERR "assertion scoping doesn't work"; + print STDERR "assertion scoping doesn't work\n"; print "not "; } print "ok ", $i++, "\n"; @@ -77,7 +133,7 @@ print "ok ", $i++, "\n"; use assertions::activate 're.*'; use assertions 'reassert'; unless (callme(1)) { - print STDERR "assertion selection with re failed"; + print STDERR "assertion selection with re failed\n"; print "not "; } print "ok ", $i++, "\n"; @@ -88,7 +144,7 @@ my $b=12; use assertions 'bar'; callme(my $b=45); unless ($b == 45) { - print STDERR "this shouldn't fail ever (b=$b)"; + print STDERR "this shouldn't fail ever (b=$b)\n"; print "not "; } } @@ -99,7 +155,7 @@ print "ok ", $i++, "\n"; no assertions; callme(my $b=46); if (defined $b) { - print STDERR "lexical declaration in assertion arg ignored"; + print STDERR "lexical declaration in assertion arg ignored (b=$b\n"; print "not "; } }