From 7788eb69fba424eb127e701f849f55d6739eb890 Mon Sep 17 00:00:00 2001 From: Ricardo SIGNES Date: Wed, 30 May 2007 17:47:15 -0400 Subject: [PATCH] minor assertions improvements Message-ID: <20070531014715.GA26562@knight.manxome.org> p4raw-id: //depot/perl@31316 --- lib/assertions.pm | 4 ++-- lib/assertions/activate.pm | 4 ++-- t/comp/assertions.t | 25 ++++++++++++++++++++++++- 3 files changed, 28 insertions(+), 5 deletions(-) diff --git a/lib/assertions.pm b/lib/assertions.pm index 6c5c211..373d850 100644 --- a/lib/assertions.pm +++ b/lib/assertions.pm @@ -73,9 +73,9 @@ sub _calc_expr { $t=($^H{assertions} & $hint) ? 1 : 0; } elsif ($t ne '0' and $t ne '1') { - $t = ( grep { ref $_ eq 'Regexp' + $t = ( grep { re::is_regexp($_) ? $t=~$_ - : $_->check($t) + : $_->($t) } @{^ASSERTING} ) ? 1 : 0; } diff --git a/lib/assertions/activate.pm b/lib/assertions/activate.pm index ba1f5de..558443d 100644 --- a/lib/assertions/activate.pm +++ b/lib/assertions/activate.pm @@ -5,7 +5,7 @@ our $VERSION = '0.02'; sub import { shift; @_ = '.*' unless @_; - push @{^ASSERTING}, map { ref $_ eq 'Regexp' ? $_ : qr/^(?:$_)\z/ } @_; + push @{^ASSERTING}, map { ref $_ ? $_ : qr/^(?:$_)\z/ } @_; } 1; @@ -33,7 +33,7 @@ Though it can also be explicetly used: The import parameters are a list of strings or of regular expressions. The assertion tags that match those regexps are enabled. If no parameter is -given, all assertions are activated. +given, all assertions are activated. References are activated as-is. =head1 SEE ALSO diff --git a/t/comp/assertions.t b/t/comp/assertions.t index f5d583d..ae25bb8 100644 --- a/t/comp/assertions.t +++ b/t/comp/assertions.t @@ -41,7 +41,7 @@ my @expr=( '1' => 1, my $supported = assertions::compat::supported(); -my $n=@expr/2 + ($supported ? 10 : 0); +my $n=@expr/2 + ($supported ? 12 : 0); my $i=1; print "1..$n\n"; @@ -168,4 +168,27 @@ if ($supported) { } } print "ok ", $i++, "\n"; + + # 11 + { + use assertions::activate sub { return 1 if $_[0] eq 'via_sub' }; + use assertions 'via_sub'; + callme(my $b=47); + unless ($b == 47) { + print STDERR "this shouldn't fail ever (b=$b)\n"; + print "not "; + } + } + print "ok ", $i++, "\n"; + + # 12 + { + use assertions 'not_asserted'; + callme(my $b=48); + if ($b == 48) { + print STDERR "this shouldn't fail ever (b=$b)\n"; + print "not "; + } + } + print "ok ", $i++, "\n"; } -- 2.7.4