This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove support for assertions and -A
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Tue, 5 Jun 2007 10:10:33 +0000 (10:10 +0000)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Tue, 5 Jun 2007 10:10:33 +0000 (10:10 +0000)
p4raw-id: //depot/perl@31333

29 files changed:
MANIFEST
cv.h
dump.c
ext/B/B.xs
ext/B/B/Concise.pm
ext/B/B/Deparse.pm
ext/B/defsubs_h.PL
ext/B/t/concise-xs.t
lib/assertions.pm [deleted file]
lib/assertions/activate.pm [deleted file]
lib/assertions/compat.pm [deleted file]
lib/perl5db.pl
op.c
perl.c
perl.h
pod/perl.pod
pod/perldiag.pod
pod/perllexwarn.pod
pod/perlrun.pod
pod/perltodo.pod
pp_hot.c
sv.c
t/comp/assertions.t [deleted file]
t/comp/asstcompat.t [deleted file]
t/op/attrs.t
t/run/switch_A.t [deleted file]
toke.c
warnings.pl
xsutils.c

index fa3620a..91e5bee 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1421,9 +1421,6 @@ lib/Archive/Tar/t/src/long/foo.tgz.packed Archive::Tar tests
 lib/Archive/Tar/t/src/short/b  Archive::Tar tests
 lib/Archive/Tar/t/src/short/bar.tar.packed     Archive::Tar tests
 lib/Archive/Tar/t/src/short/foo.tgz.packed     Archive::Tar tests
-lib/assertions/activate.pm     assertions activate/deactivate
-lib/assertions/compat.pm       assertions compatibility for earlier perls
-lib/assertions.pm              module support for -A flag
 lib/assert.pl                  assertion and panic with stack trace
 lib/Attribute/Handlers/Changes Attribute::Handlers
 lib/Attribute/Handlers/demo/demo2.pl   Attribute::Handlers demo
@@ -3368,8 +3365,6 @@ t/cmd/mod.t                       See if statement modifiers work
 t/cmd/subval.t                 See if subroutine values work
 t/cmd/switch.t                 See if switch optimizations work
 t/cmd/while.t                  See if while loops work
-t/comp/assertions.t            See if assertions work
-t/comp/asstcompat.t            See if assertions::compat work
 t/comp/bproto.t                        See if builtins conform to their prototypes
 t/comp/cmdopt.t                        See if command optimization works
 t/comp/colon.t                 See if colons are parsed correctly
@@ -3861,7 +3856,6 @@ t/run/noswitch.t          Test aliasing ARGV for other switch tests
 t/run/runenv.t                 Test if perl honors its environment variables.
 t/run/switch0.t                        Test the -0 switch
 t/run/switcha.t                        Test the -a switch
-t/run/switch_A.t               Test the -A switch
 t/run/switchC.t                        Test the -C switch
 t/run/switchd.t                        Test the -d switch
 t/run/switches.t               Tests for the other switches (-0, -l, -c, -s, -M, -m, -V, -v, -h, -z, -i)
diff --git a/cv.h b/cv.h
index 3924c83..1b0fc7b 100644 (file)
--- a/cv.h
+++ b/cv.h
@@ -139,7 +139,6 @@ Returns the stash of the CV.
 #define CVf_METHOD     0x0001  /* CV is explicitly marked as a method */
 #define CVf_LOCKED     0x0002  /* CV locks itself or first arg on entry */
 #define CVf_LVALUE     0x0004  /* CV return value can be used as lvalue */
-#define CVf_ASSERTION   0x0008  /* CV called only when asserting */
 
 #define CVf_WEAKOUTSIDE        0x0010  /* CvOUTSIDE isn't ref counted */
 #define CVf_CLONE      0x0020  /* anon CV uses external lexicals */
@@ -153,7 +152,7 @@ Returns the stash of the CV.
 #define CVf_ISXSUB     0x0800  /* CV is an XSUB, not pure perl.  */
 
 /* This symbol for optimised communication between toke.c and op.c: */
-#define CVf_BUILTIN_ATTRS      (CVf_METHOD|CVf_LOCKED|CVf_LVALUE|CVf_ASSERTION)
+#define CVf_BUILTIN_ATTRS      (CVf_METHOD|CVf_LOCKED|CVf_LVALUE)
 
 #define CvCLONE(cv)            (CvFLAGS(cv) & CVf_CLONE)
 #define CvCLONE_on(cv)         (CvFLAGS(cv) |= CVf_CLONE)
@@ -187,10 +186,6 @@ Returns the stash of the CV.
 #define CvLVALUE_on(cv)                (CvFLAGS(cv) |= CVf_LVALUE)
 #define CvLVALUE_off(cv)       (CvFLAGS(cv) &= ~CVf_LVALUE)
 
-#define CvASSERTION(cv)                (CvFLAGS(cv) & CVf_ASSERTION)
-#define CvASSERTION_on(cv)     (CvFLAGS(cv) |= CVf_ASSERTION)
-#define CvASSERTION_off(cv)    (CvFLAGS(cv) &= ~CVf_ASSERTION)
-
 #define CvEVAL(cv)             (CvUNIQUE(cv) && !SvFAKE(cv))
 #define CvEVAL_on(cv)          (CvUNIQUE_on(cv),SvFAKE_off(cv))
 #define CvEVAL_off(cv)         CvUNIQUE_off(cv)
diff --git a/dump.c b/dump.c
index 2d01693..7c28341 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1437,7 +1437,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (CvMETHOD(sv))       sv_catpv(d, "METHOD,");
        if (CvLOCKED(sv))       sv_catpv(d, "LOCKED,");
        if (CvWEAKOUTSIDE(sv))  sv_catpv(d, "WEAKOUTSIDE,");
-       if (CvASSERTION(sv))    sv_catpv(d, "ASSERTION,");
        break;
     case SVt_PVHV:
        if (HvSHAREKEYS(sv))    sv_catpv(d, "SHAREKEYS,");
index 89ddf2b..99c1409 100644 (file)
@@ -597,7 +597,6 @@ BOOT:
     specialsv_list[5] = (SV *) pWARN_NONE;
     specialsv_list[6] = (SV *) pWARN_STD;
 #if PERL_VERSION <= 8
-#  define CVf_ASSERTION        0
 #  define OPpPAD_STATE 0
 #endif
 #include "defsubs.h"
index 45e73b4..77d6c8a 100644 (file)
@@ -634,8 +634,8 @@ our %hints; # used to display each COP's op_hints values
 @hints{4096,8192,16384,32768,65536} = ('I', 'F', 'B', 'S', 'R');
 # taint and eval
 @hints{1048576,2097152} = ('T', 'E');
-# filetest access, UTF-8, assertions, assertions seen
-@hints{4194304,8388608,16777216,33554432} = ('X', 'U', 'A', 'a');
+# filetest access, UTF-8
+@hints{4194304,8388608} = ('X', 'U');
 
 sub _flags {
     my($hash, $x) = @_;
index 770b78f..895a1f1 100644 (file)
@@ -17,7 +17,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
         OPpCONST_ARYBASE OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER
         OPpSORT_REVERSE OPpSORT_INPLACE OPpSORT_DESCEND OPpITER_REVERSED
         SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR SVf_FAKE SVs_RMG SVs_SMG
-         CVf_METHOD CVf_LOCKED CVf_LVALUE CVf_ASSERTION
+         CVf_METHOD CVf_LOCKED CVf_LVALUE
         PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE
         PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED),
         ($] < 5.009 ? 'PMf_SKIPWHITE' : 'RXf_SKIPWHITE');
@@ -144,8 +144,6 @@ use warnings ();
 # - here-docs?
 
 # Current test.deparse failures
-# comp/assertions 38 - disabled assertions should be like "my($x) if 0"
-#    'sub f : assertion {}; no assertions; my $x=1; {f(my $x=2); print "$x\n"}'
 # comp/hints 6 - location of BEGIN blocks wrt. block openings
 # run/switchI 1 - missing -I switches entirely
 #    perl -Ifoo -e 'print @INC'
@@ -839,12 +837,11 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL");
     if ($cv->FLAGS & SVf_POK) {
        $proto = "(". $cv->PV . ") ";
     }
-    if ($cv->CvFLAGS & (CVf_METHOD|CVf_LOCKED|CVf_LVALUE|CVf_ASSERTION)) {
+    if ($cv->CvFLAGS & (CVf_METHOD|CVf_LOCKED|CVf_LVALUE)) {
         $proto .= ": ";
         $proto .= "lvalue " if $cv->CvFLAGS & CVf_LVALUE;
         $proto .= "locked " if $cv->CvFLAGS & CVf_LOCKED;
         $proto .= "method " if $cv->CvFLAGS & CVf_METHOD;
-        $proto .= "assertion " if $cv->CvFLAGS & CVf_ASSERTION;
     }
 
     local($self->{'curcv'}) = $cv;
index 8f943c6..8e8abd2 100644 (file)
@@ -15,7 +15,6 @@ END
 
 foreach my $const (qw(
                      CVf_ANON
-                     CVf_ASSERTION
                      CVf_CLONE
                      CVf_CLONED
                      CVf_CONST
index 00be1b8..e8b37b3 100644 (file)
@@ -119,9 +119,7 @@ use Test::More tests => ( # per-pkg tests (function ct + require_ok)
                          40 + 16       # Data::Dumper, Digest::MD5
                          + 517 + 262   # B::Deparse, B
                          + 595 + 190   # POSIX, IO::Socket
-                         + 345 * ($] > 5.009)
-                         + 17 * ($] >= 5.009003)
-                         - 366);       # fudge
+                         - 6);         # fudge
 
 require_ok("B::Concise");
 
@@ -165,7 +163,7 @@ my $testpkgs = {
        XS => [qw( svref_2object perlstring opnumber main_start
                   main_root main_cv )],
 
-       constant => [qw/ ASSIGN CVf_ASSERTION CVf_LOCKED CVf_LVALUE
+       constant => [qw/ ASSIGN CVf_LOCKED CVf_LVALUE
                     CVf_METHOD LIST_CONTEXT OP_CONST OP_LIST OP_RV2SV
                     OP_STRINGIFY OPf_KIDS OPf_MOD OPf_REF OPf_SPECIAL
                     OPf_STACKED OPf_WANT OPf_WANT_LIST OPf_WANT_SCALAR
diff --git a/lib/assertions.pm b/lib/assertions.pm
deleted file mode 100644 (file)
index 373d850..0000000
+++ /dev/null
@@ -1,338 +0,0 @@
-package assertions;
-
-our $VERSION = '0.04';
-
-# use strict;
-# use warnings;
-
-my $hint = 1;
-my $seen_hint = 2;
-
-sub _syntax_error ($$) {
-    my ($expr, $why)=@_;
-    require Carp;
-    Carp::croak("syntax error on assertion filter '$expr' ($why)");
-}
-
-sub _carp {
-    require warnings;
-    if (warnings::enabled('assertions')) {
-       require Carp;
-       Carp::carp(@_);
-    }
-}
-
-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) {
-       next if (!defined $t or $t eq '');
-
-       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]='&&';
-           }
-           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 '_') {
-                   unless ($^H{assertions} & $seen_hint) {
-                       _carp "assertion status '_' referenced but not previously defined";
-                   }
-                   $t=($^H{assertions} & $hint) ? 1 : 0;
-               }
-               elsif ($t ne '0' and $t ne '1') {
-                   $t = ( grep { re::is_regexp($_)
-                                     ? $t=~$_
-                                     : $_->($t)
-                               } @{^ASSERTING} ) ? 1 : 0;
-               }
-
-               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 @_;
-    foreach my $expr (@_) {
-       unless (_calc_expr $expr) {
-           # print STDERR "assertions deactived";
-           $^H{assertions} &= ~$hint;
-           $^H{assertions} |= $seen_hint;
-           return;
-       }
-    }
-    # print STDERR "assertions actived";
-    $^H{assertions} |= $hint|$seen_hint;
-}
-
-sub unimport {
-    @_ > 1
-       and _carp($_[0]."->unimport arguments are being ignored");
-    $^H{assertions} &= ~$hint;
-}
-
-sub enabled {
-    if (@_) {
-       if ($_[0]) {
-           $^H{assertions} |= $hint;
-       }
-       else {
-           $^H{assertions} &= ~$hint;
-       }
-       $^H{assertions} |= $seen_hint;
-    }
-    return $^H{assertions} & $hint ? 1 : 0;
-}
-
-sub seen {
-    if (@_) {
-       if ($_[0]) {
-           $^H{assertions} |= $seen_hint;
-       }
-       else {
-           $^H{assertions} &= ~$seen_hint;
-       }
-    }
-    return $^H{assertions} & $seen_hint ? 1 : 0;
-}
-
-1;
-
-__END__
-
-
-=head1 NAME
-
-assertions - select assertions in blocks of code
-
-=head1 SYNOPSIS
-
-  sub assert (&) : assertion { &{$_[0]}() }
-
-  use assertions 'foo';
-  assert { print "asserting 'foo'\n" };
-
-  {
-      use assertions qw( foo bar );
-      assert { print "asserting 'foo' and 'bar'\n" };
-  }
-
-  {
-      use assertions qw( bar );
-      assert { print "asserting only 'bar'\n" };
-  }
-
-  {
-      use assertions '_ && bar';
-      assert { print "asserting 'foo' && 'bar'\n" };
-  }
-
-  assert { print "asserting 'foo' again\n" };
-
-=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.
-
-An assertion subroutine is declared with the C<:assertion> attribute.
-This subroutine is not normally executed: it's optimized away by perl
-at compile-time.
-
-The C<assertions> pragma associates to its lexical scope one or
-several assertion tags. Then, to activate the execution of the
-assertions subroutines in this scope, these tags must be given to perl
-via the B<-A> command-line option. For instance, if...
-
-  use assertions 'foobar';
-
-is used, assertions on the same lexical scope will only be executed
-when perl is called as...
-
-  perl -A=foobar script.pl
-
-Regular expressions can also be used within the -A
-switch. For instance...
-
-  perl -A='foo.*' script.pl
-
-will activate assertions tagged as C<foo>, C<foobar>, C<foofoo>, etc.
-
-=head2 Selecting assertions
-
-Selecting which tags are required to activate assertions inside a
-lexical scope, is done with the arguments passed on the C<use
-assertions> sentence.
-
-If no arguments are given, the package name is used as the assertion tag:
-
-  use assertions;
-
-is equivalent to
-
-  use assertions __PACKAGE__;
-
-When several tags are given, all of them have to be activated via the
-C<-A> switch to activate assertion execution on that lexical scope,
-i.e.:
-
-  use assertions qw(Foo Bar);
-
-Constants C<1> and C<0> can be used to force unconditional activation
-or deactivation respectively:
-
-  use assertions '0';
-  use assertions '1';
-
-Operators C<&&> and C<||> and parenthesis C<(...)> can be used to
-construct logical expressions:
-
-  use assertions 'foo && bar';
-  use assertions 'foo || bar';
-  use assertions 'foo && (bar || doz)';
-
-(note that the logical operators and the parens have to be included
-inside the quoted string).
-
-Finally, the special tag C<_> refers to the current assertion
-activation state:
-
-  use assertions 'foo';
-  use assertions '_ && bar;
-
-is equivalent to
-
-  use assertions 'foo && bar';
-
-=head2 Handling assertions your own way
-
-The C<assertions> module also provides a set of low level functions to
-allow for custom assertion handling modules.
-
-Those functions are not exported and have to be fully qualified with
-the package name when called, for instance:
-
-  require assertions;
-  assertions::enabled(1);
-
-(note that C<assertions> is loaded with the C<require> keyword
-to avoid calling C<assertions::import()>).
-
-Those functions have to be called at compile time (they are
-useless at runtime).
-
-=over 4
-
-=item enabled($on)
-
-activates or deactivates assertion execution. For instance:
-
-  package assertions::always;
-
-  require assertions;
-  sub import { assertions::enabled(1) }
-
-  1;
-
-This function calls C<assertion::seen(1)> also (see below).
-
-=item enabled()
-
-returns a true value when assertion execution is active.
-
-=item seen($on)
-
-A warning is generated when an assertion subroutine is found before
-any assertion selection code. This function is used to just tell perl
-that assertion selection code has been seen and that the warning is
-not required for the currently compiling lexical scope.
-
-=item seen()
-
-returns true if any assertion selection module (or code) has been
-called before on the currently compiling lexical scope.
-
-=back
-
-=head1 COMPATIBILITY
-
-Support for assertions is only available in perl from version 5.9. On
-previous perl versions this module will do nothing, though it will not
-harm either.
-
-L<assertions::compat> provides an alternative way to use assertions
-compatible with lower versions of perl.
-
-
-=head1 SEE ALSO
-
-L<perlrun>, L<assertions::activate>, L<assertions::compat>.
-
-=head1 AUTHOR
-
-Salvador FandiE<ntilde>o, E<lt>sfandino@yahoo.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2002, 2005 by Salvador FandiE<ntilde>o
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
diff --git a/lib/assertions/activate.pm b/lib/assertions/activate.pm
deleted file mode 100644 (file)
index 558443d..0000000
+++ /dev/null
@@ -1,53 +0,0 @@
-package assertions::activate;
-
-our $VERSION = '0.02';
-
-sub import {
-    shift;
-    @_ = '.*' unless @_;
-    push @{^ASSERTING}, map { ref $_ ? $_ : qr/^(?:$_)\z/ } @_;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-assertions::activate - activate assertions
-
-=head1 SYNOPSIS
-
-  use assertions::activate 'Foo', 'bar', 'Foo::boz::.*';
-
-  # activate all assertions
-  use assertions::activate;
-
-=head1 DESCRIPTION
-
-This module is used internally by perl (and its C<-A> command-line switch) to
-enable and disable assertions.
-
-Though it can also be explicetly used:
-
-  use assertions::activate qw(foo bar);
-
-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.  References are activated as-is.
-
-=head1 SEE ALSO
-
-L<assertions>, L<perlrun>.
-
-=head1 AUTHOR
-
-Salvador FandiE<ntilde>o, E<lt>sfandino@yahoo.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2002, 2005 by Salvador FandiE<ntilde>o
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
diff --git a/lib/assertions/compat.pm b/lib/assertions/compat.pm
deleted file mode 100644 (file)
index 91dfb60..0000000
+++ /dev/null
@@ -1,203 +0,0 @@
-package assertions::compat;
-
-our $VERSION = '0.02';
-
-require assertions;
-our @ISA = qw(assertions);
-
-sub _on () { 1 }
-sub _off () { 0 }
-
-sub import {
-    my $class = shift;
-    my $name = @_ ? shift : 'asserting';
-    my $pkg = caller;
-    $name =~ /::/ or $name = "${pkg}::${name}";
-    @_ = $pkg unless @_;
-    $class->SUPER::import(@_);
-    my $enabled = assertions::enabled();
-    {
-       no strict 'vars';
-       no warnings;
-       undef &{$name};
-       *{$name} = $enabled ? \&_on : \&_off;
-    }
-}
-
-sub _compat_assertion_handler {
-    shift; shift;
-    grep $_ ne 'assertion', @_
-}
-
-sub _do_nothing_handler {}
-
-# test if 'assertion' attribute is natively supported
-my $assertion_ok=eval q{
-    sub _my_asserting_test : assertion { 1 }
-    _my_asserting_test()
-};
-
-*MODIFY_CODE_ATTRIBUTES =
-    defined($assertion_ok)
-    ? \&_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__
-
-=head1 NAME
-
-assertions::compat - assertions for pre-5.9 versions of perl
-
-=head1 SYNOPSIS
-
-  # add support for 'assertion' attribute:
-  use base 'assertions::compat';
-  sub assert_foo : assertion { ... };
-
-  # then, maybe in another module:
-  package Foo::Bar;
-
-  # define sub 'asserting' with the assertion status:
-  use assertions::compat;
-  asserting and assert_foo(1,2,3,4);
-
-  # or
-  use assertions::compat ASST => 'Foo::Bar::doz';
-  ASST and assert_foo('dozpera');
-
-=head1 DESCRIPTION
-
-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 conditionally executed
-subroutines.
-
-This module provides support for two different functionalities:
-
-=head2 The C<assertion> attribute handler
-
-The subroutine attribute C<assertion> is not recognised on perls
-without assertion support. This module provides a
-C<MODIFY_CODE_ATTRIBUTES> handler for this attribute. It must be used
-via inheritance:
-
-  use base 'assertions::compat';
-
-  sub assert_foo : assertion { ... }
-
-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 whose value
-is the assertion execution status. That allows checking explicitly and
-efficiently when assertions have to be executed on perls without native
-assertion support.
-
-For instance...
-
-  use assertions::compat ASST => 'Foo::Bar';
-
-exports constant subroutine C<ASST>. Its value is true when assertions
-tagged as C<Foo::Bar> has been activated via L<assertions::activate>;
-usually done with the -A switch from the command line on perls
-supporting it...
-
-  perl -A=Foo::Bar my_script.pl
-
-or alternatively with...
-
-  perl -Massertions::activate=Foo::Bar my_script.pl
-
-on pre-5.9.0 versions of perl.
-
-The constant sub defined can be used following this idiom:
-
-  use assertions::compat ASST => 'Foo::Bar';
-  ...
-  ASST and assert_foo();
-
-When ASST is false, the perl interpreter optimizes away the rest of
-the C<and> statement at compile time.
-
-
-If no assertion selection tags are passed to C<use
-assertions::compat>, the current module name is used as the selection
-tag, so...
-
-  use assertions::compat 'ASST';
-
-is equivalent to...
-
-  use assertions::compat ASST => __PACKAGE__;
-
-If the name of the constant subroutine is also omitted, C<asserting>
-is used.
-
-This module will not emit a warning when the constant is redefined.
-this is done on purpose to allow for code like that:
-
-  use assertions::compat ASST => 'Foo';
-  ASST and assert_foo();
-
-  use assertions::compat ASST => 'Bar';
-  ASST and assert_bar();
-
-Finally, be aware that while assertion execution status is lexical
-scoped, the defined constants are not. You should be careful on that
-to not write inconsistent code. For instance...
-
-  package Foo;
-
-  use MyAssertions qw(assert_foo);
-
-  use assertions::compat ASST => 'Foo::Out'
-  {
-    use assertions::compat ASST => 'Foo::In';
-    ASST and assert_foo(); # ok!
-  }
-
-  ASST and assert_foo()   # bad usage!
-  # ASST refers to tag Foo::In while assert_foo() is
-  # called only when Foo::Out has been activated.
-  # This is not what you want!!!
-
-
-=head1 SEE ALSO
-
-L<perlrun>, L<assertions>, L<assertions::activate>, L<attributes>.
-
-=head1 AUTHOR
-
-Salvador FandiE<ntilde>o, E<lt>sfandino@yahoo.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2005 by Salvador FandiE<ntilde>o
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
index 7a6848d..db0943c 100644 (file)
@@ -967,15 +967,6 @@ BEGIN {
     $^W       = 0;
 }    # Switch compilation warnings off until another BEGIN.
 
-# test if assertions are supported and actived:
-BEGIN {
-    $ini_assertion = eval "sub asserting_test : assertion {1}; 1";
-
-    # $ini_assertion = undef => assertions unsupported,
-    #        "       = 1     => assertions supported
-    # print "\$ini_assertion=$ini_assertion\n";
-}
-
 local ($^W) = 0;    # Switch run-time warnings off during init.
 
 =head2 THREADS SUPPORT
@@ -1102,10 +1093,10 @@ are to be accepted.
   signalLevel  warnLevel     dieLevel
   inhibit_exit ImmediateStop bareStringify
   CreateTTY    RemotePort    windowSize
-  DollarCaretP OnlyAssertions WarnAssertions
+  DollarCaretP
 );
 
-@RememberOnROptions = qw(DollarCaretP OnlyAssertions);
+@RememberOnROptions = qw(DollarCaretP);
 
 =pod
 
@@ -1134,7 +1125,6 @@ state.
     ImmediateStop => \$ImmediateStop,
     RemotePort    => \$remoteport,
     windowSize    => \$window,
-    WarnAssertions => \$warnassertions,
     HistFile      => \$histfile,
     HistSize      => \$histsize,
 );
@@ -1165,7 +1155,6 @@ option.
     ornaments     => \&ornaments,
     RemotePort    => \&RemotePort,
     DollarCaretP  => \&DollarCaretP,
-    OnlyAssertions=> \&OnlyAssertions,
 );
 
 =pod
@@ -3697,17 +3686,7 @@ sub sub {
         # Called in array context. call sub and capture output.
         # DB::DB will recursively get control again if appropriate; we'll come
         # back here when the sub is finished.
-        if ($assertion) {
-            $assertion = 0;
-            eval { @ret = &$sub; };
-            if ($@) {
-                print $OUT $@;
-                $signal = 1 unless $warnassertions;
-            }
-        }
-        else {
-            @ret = &$sub;
-        }
+       @ret = &$sub;
 
         # Pop the single-step value back off the stack.
         $single |= $stack[ $stack_depth-- ];
@@ -3748,32 +3727,17 @@ sub sub {
 
     # Scalar context.
     else {
-        if ($assertion) {
-            $assertion = 0;
-            eval {
-
-                # Save the value if it's wanted at all.
-                $ret = &$sub;
-            };
-            if ($@) {
-                print $OUT $@;
-                $signal = 1 unless $warnassertions;
-            }
-            $ret = undef unless defined wantarray;
-        }
-        else {
-            if ( defined wantarray ) {
+       if ( defined wantarray ) {
 
-                # Save the value if it's wanted at all.
-                $ret = &$sub;
-            }
-            else {
+           # Save the value if it's wanted at all.
+           $ret = &$sub;
+       }
+       else {
 
-                # Void return, explicitly.
-                &$sub;
-                undef $ret;
-            }
-        }    # if assertion
+           # Void return, explicitly.
+           &$sub;
+           undef $ret;
+       }
 
         # Pop the single-step value off the stack.
         $single |= $stack[ $stack_depth-- ];
@@ -5343,38 +5307,6 @@ sub cmd_W {
 These are general support routines that are used in a number of places
 throughout the debugger.
 
-=over 4
-
-=item cmd_P
-
-Something to do with assertions
-
-=back
-
-=cut
-
-sub cmd_P {
-    unless ($ini_assertion) {
-        print $OUT "Assertions not supported in this Perl interpreter\n";
-    } else {
-        if ( $cmd =~ /^.\b\s*([+-]?)\s*(~?)\s*(\w+(\s*\|\s*\w+)*)\s*$/ ) {
-            my ( $how, $neg, $flags ) = ( $1, $2, $3 );
-            my $acu = parse_DollarCaretP_flags($flags);
-            if ( defined $acu ) {
-                $acu = ~$acu if $neg;
-                if ( $how eq '+' ) { $^P |= $acu }
-                elsif ( $how eq '-' ) { $^P &= ~$acu }
-                else { $^P = $acu }
-            }
-
-            # else { print $OUT "undefined acu\n" }
-        }
-        my $expanded = expand_DollarCaretP_flags($^P);
-        print $OUT "Internal Perl debugger flags:\n\$^P=$expanded\n";
-        $expanded;
-    }
-}
-
 =head2 save
 
 save() saves the user's versions of globals that would mess us up in C<@saved>,
@@ -6946,33 +6878,6 @@ sub DollarCaretP {
     expand_DollarCaretP_flags($^P);
 }
 
-sub OnlyAssertions {
-    if ($term) {
-        &warn("Too late to set up OnlyAssertions mode, enabled on next 'R'!\n")
-          if @_;
-    }
-    if (@_) {
-        unless ( defined $ini_assertion ) {
-            if ($term) {
-                &warn("Current Perl interpreter doesn't support assertions");
-            }
-            return 0;
-        }
-        if (shift) {
-            unless ($ini_assertion) {
-                print "Assertions will be active on next 'R'!\n";
-                $ini_assertion = 1;
-            }
-            $^P &= ~$DollarCaretP_flags{PERLDBf_SUB};
-            $^P |= $DollarCaretP_flags{PERLDBf_ASSERTION};
-        }
-        else {
-            $^P |= $DollarCaretP_flags{PERLDBf_SUB};
-        }
-    }
-    !( $^P & $DollarCaretP_flags{PERLDBf_SUB} ) || 0;
-}
-
 =head2 C<pager>
 
 Set up the C<$pager> variable. Adds a pipe to the front unless there's one
@@ -7235,7 +7140,6 @@ B<i> I<class>       Prints nested parents of given class.
 B<e>         Display current thread id.
 B<E>         Display all thread ids the current one will be identified: <n>.
 B<y> [I<n> [I<Vars>]]   List lexicals in higher scope <n>.  Vars same as B<V>.
-B<P> Something to do with assertions...
 
 B<<> ?            List Perl commands to run before each prompt.
 B<<> I<expr>        Define Perl command to run before each prompt.
@@ -8762,8 +8666,7 @@ BEGIN {
         PERLDBf_GOTO      => 0x80,     # Report goto: call DB::goto
         PERLDBf_NAMEEVAL  => 0x100,    # Informative names for evals
         PERLDBf_NAMEANON  => 0x200,    # Informative names for anon subs
-        PERLDBf_ASSERTION => 0x400,    # Debug assertion subs enter/exit
-        PERLDB_ALL        => 0x33f,    # No _NONAME, _GOTO, _ASSERTION
+        PERLDB_ALL        => 0x33f,    # No _NONAME, _GOTO
     );
 
     %DollarCaretP_flags_r = reverse %DollarCaretP_flags;
@@ -8869,11 +8772,6 @@ sub restart {
 
     # If warn was on before, turn it on again.
     push @flags, '-w' if $ini_warn;
-    if ( $ini_assertion and @{^ASSERTING} ) {
-        push @flags,
-          ( map { /\:\^\(\?\:(.*)\)\$\)/ ? "-A$1" : "-A$_" }
-              @{^ASSERTING} );
-    }
 
     # Rebuild the -I flags that were on the initial
     # command line.
diff --git a/op.c b/op.c
index 2269f7e..d29b36d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7507,26 +7507,6 @@ Perl_ck_subr(pTHX_ OP *o)
                    proto = SvPV((SV*)cv, len);
                    proto_end = proto + len;
                }
-               if (CvASSERTION(cv)) {
-                   U32 asserthints = 0;
-                   HV *const hinthv = GvHV(PL_hintgv);
-                   if (hinthv) {
-                       SV **svp = hv_fetchs(hinthv, "assertions", FALSE);
-                       if (svp && *svp)
-                           asserthints = SvUV(*svp);
-                   }
-                   if (asserthints & HINT_ASSERTING) {
-                       if (PERLDB_ASSERTION && PL_curstash != PL_debstash)
-                           o->op_private |= OPpENTERSUB_DB;
-                   }
-                   else {
-                       delete_op = 1;
-                       if (!(asserthints & HINT_ASSERTIONSSEEN) && ckWARN(WARN_ASSERTIONS)) {
-                           Perl_warner(aTHX_ packWARN(WARN_ASSERTIONS),
-                                       "Impossible to activate assertion call");
-                       }
-                   }
-               }
            }
        }
     }
diff --git a/perl.c b/perl.c
index c62722a..119e6f5 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -971,7 +971,6 @@ perl_destruct(pTHXx)
     PL_DBsingle = NULL;
     PL_DBtrace = NULL;
     PL_DBsignal = NULL;
-    PL_DBassertion = NULL;
     PL_DBcv = NULL;
     PL_dbargs = NULL;
     PL_debstash = NULL;
@@ -1716,7 +1715,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
        case 'W':
        case 'X':
        case 'w':
-       case 'A':
            if ((s = moreswitches(s)))
                goto reswitch;
            break;
@@ -2908,7 +2906,6 @@ S_usage(pTHX_ const char *name)           /* XXX move this out into a module ? */
 
     static const char * const usage_msg[] = {
 "-0[octal]         specify record separator (\\0, if no argument)",
-"-A[mod][=pattern] activate all/given assertions",
 "-a                autosplit mode with -n or -p (splits $_ into @F)",
 "-C[number/list]   enables the listed Unicode features",
 "-c                check syntax only (runs BEGIN and CHECK blocks)",
@@ -3206,27 +3203,6 @@ Perl_moreswitches(pTHX_ char *s)
            }
        }
        return s;
-    case 'A':
-       forbid_setid('A', -1);
-       s++;
-       {
-           char * const start = s;
-           SV * const sv = newSVpvs("use assertions::activate");
-           while(isALNUM(*s) || *s == ':') ++s;
-           if (s != start) {
-               sv_catpvs(sv, "::");
-               sv_catpvn(sv, start, s-start);
-           }
-           if (*s == '=') {
-               Perl_sv_catpvf(aTHX_ sv, " split(/,/,q%c%s%c)", 0, ++s, 0);
-               s+=strlen(s);
-           }
-           else if (*s != '\0') {
-               Perl_croak(aTHX_ "Can't use '%c' after -A%.*s", *s, (int)(s-start), start);
-           }
-           Perl_av_create_and_push(aTHX_ &PL_preambleav, sv);
-           return s;
-       }
     case 'M':
        forbid_setid('M', -1);  /* XXX ? */
        /* FALL THROUGH */
@@ -4500,8 +4476,6 @@ Perl_init_debugger(pTHX)
     sv_setiv(PL_DBtrace, 0);
     PL_DBsignal = GvSV((gv_fetchpvs("DB::signal", GV_ADDMULTI, SVt_PV)));
     sv_setiv(PL_DBsignal, 0);
-    PL_DBassertion = GvSV((gv_fetchpvs("DB::assertion", GV_ADDMULTI, SVt_PV)));
-    sv_setiv(PL_DBassertion, 0);
     PL_curstash = ostash;
 }
 
diff --git a/perl.h b/perl.h
index 6dc5ab4..2992869 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -4395,10 +4395,6 @@ enum {           /* pass one of these to get_vtbl */
 #define HINT_FILETEST_ACCESS   0x00400000 /* filetest pragma */
 #define HINT_UTF8              0x00800000 /* utf8 pragma */
 
-/* assertions pragma, stored in $^H{assertions} */
-#define HINT_ASSERTING          0x00000001
-#define HINT_ASSERTIONSSEEN     0x00000002
-
 /* The following are stored in $^H{sort}, not in PL_hints */
 #define HINT_SORT_SORT_BITS    0x000000FF /* allow 256 different ones */
 #define HINT_SORT_QUICKSORT    0x00000001
@@ -5099,7 +5095,6 @@ typedef struct am_table_short AMTS;
 #define PERLDBf_GOTO           0x80    /* Report goto: call DB::goto */
 #define PERLDBf_NAMEEVAL       0x100   /* Informative names for evals */
 #define PERLDBf_NAMEANON       0x200   /* Informative names for anon subs */
-#define PERLDBf_ASSERTION       0x400   /* Debug assertion subs enter/exit */
 
 #define PERLDB_SUB     (PL_perldb && (PL_perldb & PERLDBf_SUB))
 #define PERLDB_LINE    (PL_perldb && (PL_perldb & PERLDBf_LINE))
index bf24ed8..15b8106 100644 (file)
@@ -9,7 +9,6 @@ B<perl> S<[ B<-sTtuUWX> ]>
        S<[ B<-cw> ] [ B<-d>[B<t>][:I<debugger>] ] [ B<-D>[I<number/list>] ]>
        S<[ B<-pna> ] [ B<-F>I<pattern> ] [ B<-l>[I<octal>] ] [ B<-0>[I<octal/hexadecimal>] ]>
        S<[ B<-I>I<dir> ] [ B<-m>[B<->]I<module> ] [ B<-M>[B<->]I<'module...'> ] [ B<-f> ]>
-       S<[ B<-A>[I<module>][=I<assertions>] ]>
        S<[ B<-C [I<number/list>] >]>
        S<[ B<-P> ]>
        S<[ B<-S> ]>
index b5d125f..e118220 100644 (file)
@@ -1967,11 +1967,6 @@ name or CLI symbol definition when preparing to iterate over %ENV, and
 didn't see the expected delimiter between key and value, so the line was
 ignored.
 
-=item Impossible to activate assertion call
-
-(W assertions) You're calling an assertion function in a block that is
-not under the control of the C<assertions> pragma.
-
 =item (in cleanup) %s
 
 (W misc) This prefix usually indicates that a DESTROY() method raised
index 93ec769..bed349f 100644 (file)
@@ -212,8 +212,6 @@ The current hierarchy is:
 
   all -+
        |
-       +- assertions
-       |
        +- closure
        |
        +- deprecated
index 7ab7912..a72c2c0 100644 (file)
@@ -9,7 +9,6 @@ B<perl> S<[ B<-sTtuUWX> ]>
        S<[ B<-cw> ] [ B<-d>[B<t>][:I<debugger>] ] [ B<-D>[I<number/list>] ]>
        S<[ B<-pna> ] [ B<-F>I<pattern> ] [ B<-l>[I<octal>] ] [ B<-0>[I<octal/hexadecimal>] ]>
        S<[ B<-I>I<dir> ] [ B<-m>[B<->]I<module> ] [ B<-M>[B<->]I<'module...'> ] [ B<-f> ]>
-       S<[ B<-A>[I<module>][=I<assertions>] ]>
        S<[ B<-C [I<number/list>] >]>
        S<[ B<-P> ]>
        S<[ B<-S> ]>
@@ -260,19 +259,6 @@ format: C<-0xHHH...>, where the C<H> are valid hexadecimal digits.
 (This means that you cannot use the C<-x> with a directory name that
 consists of hexadecimal digits.)
 
-=item B<-A[I<module>][=I<assertions>]>
-X<-A>
-
-Activates the assertions given after the equal sign as a comma-separated
-list of assertion names or regular expressions. If no assertion name
-is given, activates all assertions.
-
-The module L<assertions::activate> is used by default to activate the
-selected assertions. An alternate module may be specified including
-its name between the switch and the equal sign.
-
-See L<assertions> and L<assertions::activate>.
-
 =item B<-a>
 X<-a> X<autosplit>
 
index 48acd2c..6a0d33d 100644 (file)
@@ -603,15 +603,6 @@ instated.
 
 The old perltodo notes "Look at the "reification" code in C<av.c>".
 
-=head2 What hooks would assertions need?
-
-Assertions are in the core, and work. However, assertions needed to be added
-as a core patch, rather than an XS module in ext, or a CPAN module, because
-the core has no hooks in the necessary places. It would be useful to
-investigate what hooks would need to be added to make it possible to provide
-the full assertion support from a CPAN module, so that we aren't constraining
-the imagination of future CPAN authors.
-
 =head2 Properly Unicode safe tokeniser and pads.
 
 The tokeniser isn't actually very UTF-8 clean. C<use utf8;> is a hack -
index 35e8868..27e863d 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2710,9 +2710,6 @@ try_autoload:
 
     gimme = GIMME_V;
     if ((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) && !CvNODEBUG(cv)) {
-        if (CvASSERTION(cv) && PL_DBassertion)
-           sv_setiv(PL_DBassertion, 1);
-       
         Perl_get_db_sub(aTHX_ &sv, cv);
         if (CvISXSUB(cv))
             PL_curcopdb = PL_curcop;
diff --git a/sv.c b/sv.c
index 426cd64..005633a 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -11137,7 +11137,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_DBsingle                = sv_dup(proto_perl->IDBsingle, param);
     PL_DBtrace         = sv_dup(proto_perl->IDBtrace, param);
     PL_DBsignal                = sv_dup(proto_perl->IDBsignal, param);
-    PL_DBassertion      = sv_dup(proto_perl->IDBassertion, param);
     PL_dbargs          = av_dup(proto_perl->Idbargs, param);
 
     /* symbol tables */
diff --git a/t/comp/assertions.t b/t/comp/assertions.t
deleted file mode 100644 (file)
index ae25bb8..0000000
+++ /dev/null
@@ -1,194 +0,0 @@
-#!./perl
-
-BEGIN { $^W=0 }
-
-use base 'assertions::compat';
-
-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 $supported = assertions::compat::supported();
-
-my $n=@expr/2 + ($supported ? 12 : 0);
-my $i=1;
-print "1..$n\n";
-
-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";
-}
-
-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;
-       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';
-    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;
-    {
-       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";
-
-    # 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";
-}
diff --git a/t/comp/asstcompat.t b/t/comp/asstcompat.t
deleted file mode 100644 (file)
index 87d175b..0000000
+++ /dev/null
@@ -1,42 +0,0 @@
-#!./perl
-
-BEGIN { $^W = 0 }
-
-my $i = 1;
-sub ok {
-    my $ok = shift;
-    print( ($ok ? '' : 'not '), "ok $i", (@_ ? " - @_" : ''), "\n");
-    $i++;
-}
-
-print "1..7\n";
-
-# 1
-use base 'assertions::compat';
-ok(eval "sub assert_foo : assertion { 0 } ; 1", "handle assertion attribute");
-
-use assertions::activate 'Foo';
-
-# 2
-use assertions::compat asserting_2 => 'Foo';
-ok(asserting_2, 'on');
-
-# 3
-use assertions::compat asserting_3 => 'Bar';
-ok(!asserting_3, 'off');
-
-# 4
-use assertions::compat asserting_4 => '_ || Bar';
-ok(!asserting_4, 'current off or off');
-
-# 5
-use assertions::compat asserting_5 => '_ || Foo';
-ok(asserting_5, 'current off or on');
-
-# 6
-use assertions::compat asserting_6 => '_ || Bar';
-ok(asserting_6, 'current on or off');
-
-# 7
-use assertions::compat asserting_7 => '_ && Foo';
-ok(asserting_7, 'current on and on');
index 7b20210..04e4517 100644 (file)
@@ -159,7 +159,6 @@ like $@, qr/Can't declare scalar dereference in "my"/;
 
 
 my @code = qw(lvalue locked method);
-unshift @code, 'assertion' if $] >= 5.009;
 my @other = qw(shared unique);
 my %valid;
 $valid{CODE} = {map {$_ => 1} @code};
diff --git a/t/run/switch_A.t b/t/run/switch_A.t
deleted file mode 100755 (executable)
index 5111b9d..0000000
+++ /dev/null
@@ -1,37 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require './test.pl';
-}
-
-BEGIN {
-    plan(5);
-}
-
-#1
-fresh_perl_is('sub cm : assertion { "ok" }; use assertions Hello; print cm()',
-             'ok',
-             { switches => ['-A=Hello'] }, '-A=Hello');
-
-#2
-fresh_perl_is('sub cm : assertion { "ok" }; use assertions SDFJKS; print cm()',
-             'ok',
-             { switches => ['-A=.*'] }, '-A=.*');
-
-#3
-fresh_perl_is('sub cm : assertion { "ok" }; use assertions Bye; print cm()',
-             'ok',
-             { switches => ['-A=B.e'] }, '-A=B.e');
-
-#4
-fresh_perl_is('sub cm : assertion { "ok" }; use assertions Hello; print cm()',
-             '0',
-             { switches => ['-A=NoH..o'] }, '-A=NoH..o');
-
-#5
-fresh_perl_is('sub cm : assertion { "ok" }; use assertions Hello; print cm()',
-             'ok',
-             { switches => ['-A'] }, '-A');
-
diff --git a/toke.c b/toke.c
index 6959773..a375a77 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -4296,10 +4296,6 @@ Perl_yylex(pTHX)
                        sv_free(sv);
                        CvMETHOD_on(PL_compcv);
                    }
-                   else if (!PL_in_my && len == 9 && strnEQ(SvPVX(sv), "assertion", len)) {
-                       sv_free(sv);
-                       CvASSERTION_on(PL_compcv);
-                   }
                    /* After we've set the flags, it could be argued that
                       we don't need to do the attributes.pm-based setting
                       process, and shouldn't bother appending recognized
index d342a39..63cc677 100644 (file)
@@ -61,7 +61,6 @@ my $tree = {
                'pack'          => [ 5.008, DEFAULT_OFF],
                'unpack'        => [ 5.008, DEFAULT_OFF],
                'threads'       => [ 5.008, DEFAULT_OFF],
-       'assertions'    => [ 5.009, DEFAULT_OFF],
 
                 #'default'     => [ 5.008, DEFAULT_ON ],
        }],
index 4ea4de2..0f8436b 100644 (file)
--- a/xsutils.c
+++ b/xsutils.c
@@ -71,17 +71,6 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs)
        switch (SvTYPE(sv)) {
        case SVt_PVCV:
            switch ((int)len) {
-#ifdef CVf_ASSERTION
-           case 9:
-               if (memEQ(name, "assertion", 9)) {
-                   if (negated)
-                       CvFLAGS((CV*)sv) &= ~CVf_ASSERTION;
-                   else
-                       CvFLAGS((CV*)sv) |= CVf_ASSERTION;
-                   continue;
-               }
-               break;
-#endif
            case 6:
                switch (name[3]) {
 #ifdef CVf_LVALUE
@@ -230,8 +219,6 @@ usage:
            XPUSHs(sv_2mortal(newSVpvs("method")));
         if (GvUNIQUE(CvGV((CV*)sv)))
            XPUSHs(sv_2mortal(newSVpvs("unique")));
-       if (cvflags & CVf_ASSERTION)
-           XPUSHs(sv_2mortal(newSVpvs("assertion")));
        break;
     case SVt_PVGV:
        if (GvUNIQUE(sv))