Remove support for assertions and -A

p4raw-id: //depot/perl@31333

4 files changed, 13 insertions, 709 deletions

diff --git a/lib/assertions.pm b/lib/assertions.pm
deleted file mode 100644
index 373d8504bf..0000000000
--- a/lib/assertions.pm
+++ /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
index 558443d758..0000000000
--- a/lib/assertions/activate.pm
+++ /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
index 91dfb60e3c..0000000000
--- a/lib/assertions/compat.pm
+++ /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
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 7a6848db15..db0943c0b5 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -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.