From: Ricardo SIGNES <rjbs@cpan.org>
Date: Wed, 30 May 2007 21:47:15 +0000 (-0400)
Subject: minor assertions improvements
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7788eb69fba424eb127e701f849f55d6739eb890;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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";
 }