Upgrade to assertions-0.03
Steve Peters [Wed, 1 Mar 2006 16:29:37 +0000 (16:29 +0000)]
p4raw-id: //depot/perl@27356

lib/assertions.pm
lib/assertions/activate.pm
lib/assertions/compat.pm
t/comp/assertions.t
t/comp/asstcompat.t

index 0ced4bc..6bf131d 100644 (file)
@@ -1,6 +1,6 @@
 package assertions;
 
-our $VERSION = '0.02';
+our $VERSION = '0.03';
 
 # use strict;
 # use warnings;
@@ -184,6 +184,10 @@ assertions - select assertions in blocks of code
 
 =head1 DESCRIPTION
 
+  *** WARNING: assertion support is only available from perl version
+  *** 5.9.0 and upwards. Check assertions::compat (also available from
+  *** this package) for an alternative backwards compatible module.
+
 The C<assertions> pragma specifies the tags used to enable and disable
 the execution of assertion subroutines.
 
index 04bc032..ba1f5de 100644 (file)
@@ -27,7 +27,7 @@ assertions::activate - activate assertions
 This module is used internally by perl (and its C<-A> command-line switch) to
 enable and disable assertions.
 
-It can also be used directly:
+Though it can also be explicetly used:
 
   use assertions::activate qw(foo bar);
 
index 156f897..91dfb60 100644 (file)
@@ -1,5 +1,7 @@
 package assertions::compat;
 
+our $VERSION = '0.02';
+
 require assertions;
 our @ISA = qw(assertions);
 
@@ -40,6 +42,18 @@ my $assertion_ok=eval q{
     ? \&_do_nothing_handler
     : \&_compat_assertion_handler;
 
+*supported =
+    defined($assertion_ok)
+    ? \&_on
+    : \&_off;
+
+unless (defined $assertion_ok) {
+    package assertions;
+    require warnings::register;
+    warnings::register->import;
+}
+
+
 1;
 
 __END__
@@ -69,7 +83,7 @@ assertions::compat - assertions for pre-5.9 versions of perl
 
 C<assertions::compat> allows to use assertions on perl versions prior
 to 5.9.0 (that is the first one to natively support them). Though,
-it's not magic, do not expect it to allow for conditional executed
+it's not magic, do not expect it to allow for conditionally executed
 subroutines.
 
 This module provides support for two different functionalities:
@@ -89,11 +103,17 @@ Be aware that the handler just discards the attribute, so subroutines
 declared as assertions will be B<unconditionally> called on perl without
 native support for them.
 
+This module also provides the C<supported> function to check if
+assertions are supported or not:
+
+  my $supported = assertions::compat::supported();
+
+
 =head2 Assertion execution status as a constant
 
-C<assertions::compat> also allows to create constant subs which value
+C<assertions::compat> also allows to create constant subs whose value
 is the assertion execution status. That allows checking explicitly and
-efficiently if assertions have to be executed on perls without native
+efficiently when assertions have to be executed on perls without native
 assertion support.
 
 For instance...
@@ -123,7 +143,7 @@ When ASST is false, the perl interpreter optimizes away the rest of
 the C<and> statement at compile time.
 
 
-When no assertion selection tags are passed to C<use
+If no assertion selection tags are passed to C<use
 assertions::compat>, the current module name is used as the selection
 tag, so...
 
@@ -146,8 +166,8 @@ this is done on purpose to allow for code like that:
   ASST and assert_bar();
 
 Finally, be aware that while assertion execution status is lexical
-scoped, defined constants are not. You should be careful on that to
-not write inconsistent code. For instance...
+scoped, the defined constants are not. You should be careful on that
+to not write inconsistent code. For instance...
 
   package Foo;
 
index 9edc13a..f5d583d 100644 (file)
@@ -1,5 +1,9 @@
 #!./perl
 
+BEGIN { $^W=0 }
+
+use base 'assertions::compat';
+
 sub callme ($ ) : assertion {
     return shift;
 }
@@ -35,7 +39,9 @@ my @expr=( '1' => 1,
           ' ( 1 && 0 ) ' => 0,
           '(( 1 && 1) && ( 1 || 0)) || _ && one && ( one || three)' => 1 );
 
-my $n=@expr/2+10;
+my $supported = assertions::compat::supported();
+
+my $n=@expr/2 + ($supported ? 10 : 0);
 my $i=1;
 print "1..$n\n";
 
@@ -63,100 +69,103 @@ while (@expr) {
     print "ok ", $i++, "\n";
 }
 
+if ($supported) {
 
-# @expr/2+1
-if (callme(1)) {
-    print STDERR "assertions called by default\n";
-    print "not ";
-}
-print "ok ", $i++, "\n";
-
-# 2
-use assertions::activate 'mine';
-{
-  package mine;
-  sub callme ($) : assertion {
-    return shift;
-  }
-  use assertions;
-  unless (callme(1)) {
-    print STDERR "'use assertions;' doesn't active assertions based on package name\n";
-    print "not ";
-  }
-}
-print "ok ", $i++, "\n";
-
-# 3
-use assertions 'foo';
-if (callme(1)) {
-    print STDERR "assertion deselection doesn't work\n";
-    print "not ";
-}
-print "ok ", $i++, "\n";
-
-# 4
-use assertions::activate 'bar', 'doz';
-use assertions 'bar';
-unless (callme(1)) {
-    print STDERR "assertion selection doesn't work\n";
-    print "not ";
-}
-print "ok ", $i++, "\n";
-
-# 5
-use assertions q(_ && doz);
-unless (callme(1)) {
-    print STDERR "assertion activation filtering doesn't work\n";
-    print "not ";
-}
-print "ok ", $i++, "\n";
-
-# 6
-use assertions q(_ && foo);
-if (callme(1)) {
-    print STDERR "assertion deactivation filtering doesn't work\n";
-    print "not ";
-}
-print "ok ", $i++, "\n";
-
-# 7
-if (1) {
-    use assertions 'bar';
-}
-if (callme(1)) {
-    print STDERR "assertion scoping doesn't work\n";
-    print "not ";
-}
-print "ok ", $i++, "\n";
-
-# 8
-use assertions::activate 're.*';
-use assertions 'reassert';
-unless (callme(1)) {
-    print STDERR "assertion selection with re failed\n";
-    print "not ";
-}
-print "ok ", $i++, "\n";
-
-# 9
-my $b=12;
-{
+    # @expr/2+1
+    if (callme(1)) {
+       print STDERR "assertions called by default\n";
+       print "not ";
+    }
+    print "ok ", $i++, "\n";
+    
+    # 2
+    use assertions::activate 'mine';
+    {
+       package mine;
+       use base 'assertions::compat';
+       sub callme ($) : assertion {
+           return shift;
+       }
+           use assertions;
+       unless (callme(1)) {
+           print STDERR "'use assertions;' doesn't active assertions based on package name\n";
+           print "not ";
+       }
+    }
+    print "ok ", $i++, "\n";
+    
+    # 3
+    use assertions 'foo';
+    if (callme(1)) {
+       print STDERR "assertion deselection doesn't work\n";
+       print "not ";
+    }
+    print "ok ", $i++, "\n";
+    
+    # 4
+    use assertions::activate 'bar', 'doz';
     use assertions 'bar';
-    callme(my $b=45);
-    unless ($b == 45) {
-       print STDERR "this shouldn't fail ever (b=$b)\n";
+    unless (callme(1)) {
+       print STDERR "assertion selection doesn't work\n";
        print "not ";
     }
-}
-print "ok ", $i++, "\n";
+    print "ok ", $i++, "\n";
+    
+    # 5
+    use assertions q(_ && doz);
+    unless (callme(1)) {
+       print STDERR "assertion activation filtering doesn't work\n";
+       print "not ";
+    }
+    print "ok ", $i++, "\n";
+    
+    # 6
+    use assertions q(_ && foo);
+    if (callme(1)) {
+       print STDERR "assertion deactivation filtering doesn't work\n";
+       print "not ";
+    }
+    print "ok ", $i++, "\n";
+    
+    # 7
+    if (1) {
+       use assertions 'bar';
+    }
+    if (callme(1)) {
+       print STDERR "assertion scoping doesn't work\n";
+       print "not ";
+    }
+    print "ok ", $i++, "\n";
 
-# 10
-{
-    no assertions;
-    callme(my $b=46);
-    if (defined $b) {
-       print STDERR "lexical declaration in assertion arg ignored (b=$b\n";
+    # 8
+    use assertions::activate 're.*';
+    use assertions 'reassert';
+    unless (callme(1)) {
+       print STDERR "assertion selection with re failed\n";
        print "not ";
     }
+    print "ok ", $i++, "\n";
+
+    # 9
+    my $b=12;
+    {
+       use assertions 'bar';
+       callme(my $b=45);
+       unless ($b == 45) {
+           print STDERR "this shouldn't fail ever (b=$b)\n";
+           print "not ";
+       }
+    }
+    print "ok ", $i++, "\n";
+
+    # 10
+    {
+       no assertions;
+       callme(my $b=46);
+       if (defined $b) {
+           print STDERR "lexical declaration in assertion arg ignored (b=$b\n";
+           print "not ";
+       }
+    }
+    print "ok ", $i++, "\n";
 }
-print "ok ", $i++, "\n";
index fa0a357..87d175b 100644 (file)
@@ -1,5 +1,7 @@
 #!./perl
 
+BEGIN { $^W = 0 }
+
 my $i = 1;
 sub ok {
     my $ok = shift;