minor assertions improvements

Message-ID: <20070531014715.GA26562@knight.manxome.org>

p4raw-id: //depot/perl@31316

diff --git a/lib/assertions.pm b/lib/assertions.pm
index 6c5c211..373d850 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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";
 }