From 584420f022db57225e9644b9c6668ff9f567984a Mon Sep 17 00:00:00 2001 From: Rafael Garcia-Suarez Date: Tue, 5 Jun 2007 10:10:33 +0000 Subject: [PATCH] Remove support for assertions and -A p4raw-id: //depot/perl@31333 --- MANIFEST | 6 - cv.h | 7 +- dump.c | 1 - ext/B/B.xs | 1 - ext/B/B/Concise.pm | 4 +- ext/B/B/Deparse.pm | 7 +- ext/B/defsubs_h.PL | 1 - ext/B/t/concise-xs.t | 6 +- lib/assertions.pm | 338 --------------------------------------------- lib/assertions/activate.pm | 53 ------- lib/assertions/compat.pm | 203 --------------------------- lib/perl5db.pl | 128 ++--------------- op.c | 20 --- perl.c | 26 ---- perl.h | 5 - pod/perl.pod | 1 - pod/perldiag.pod | 5 - pod/perllexwarn.pod | 2 - pod/perlrun.pod | 14 -- pod/perltodo.pod | 9 -- pp_hot.c | 3 - sv.c | 1 - t/comp/assertions.t | 194 -------------------------- t/comp/asstcompat.t | 42 ------ t/op/attrs.t | 1 - t/run/switch_A.t | 37 ----- toke.c | 4 - warnings.pl | 1 - xsutils.c | 13 -- 29 files changed, 20 insertions(+), 1113 deletions(-) delete mode 100644 lib/assertions.pm delete mode 100644 lib/assertions/activate.pm delete mode 100644 lib/assertions/compat.pm delete mode 100644 t/comp/assertions.t delete mode 100644 t/comp/asstcompat.t delete mode 100755 t/run/switch_A.t diff --git a/MANIFEST b/MANIFEST index fa3620a..91e5bee 100644 --- 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 --- 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 --- 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,"); diff --git a/ext/B/B.xs b/ext/B/B.xs index 89ddf2b..99c1409 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -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" diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 45e73b4..77d6c8a 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -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) = @_; diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index 770b78f..895a1f1 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -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; diff --git a/ext/B/defsubs_h.PL b/ext/B/defsubs_h.PL index 8f943c6..8e8abd2 100644 --- a/ext/B/defsubs_h.PL +++ b/ext/B/defsubs_h.PL @@ -15,7 +15,6 @@ END foreach my $const (qw( CVf_ANON - CVf_ASSERTION CVf_CLONE CVf_CLONED CVf_CONST diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t index 00be1b8..e8b37b3 100644 --- a/ext/B/t/concise-xs.t +++ b/ext/B/t/concise-xs.t @@ -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 index 373d850..0000000 --- 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 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 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, C, C, 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 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 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 is loaded with the C keyword -to avoid calling C). - -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 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 provides an alternative way to use assertions -compatible with lower versions of perl. - - -=head1 SEE ALSO - -L, L, L. - -=head1 AUTHOR - -Salvador FandiEo, Esfandino@yahoo.comE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2002, 2005 by Salvador FandiEo - -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 558443d..0000000 --- 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, L. - -=head1 AUTHOR - -Salvador FandiEo, Esfandino@yahoo.comE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2002, 2005 by Salvador FandiEo - -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 91dfb60..0000000 --- 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 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 attribute handler - -The subroutine attribute C is not recognised on perls -without assertion support. This module provides a -C 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 called on perl without -native support for them. - -This module also provides the C function to check if -assertions are supported or not: - - my $supported = assertions::compat::supported(); - - -=head2 Assertion execution status as a constant - -C 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. Its value is true when assertions -tagged as C has been activated via L; -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 statement at compile time. - - -If no assertion selection tags are passed to C, 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 -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, L, L, L. - -=head1 AUTHOR - -Salvador FandiEo, Esfandino@yahoo.comE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2005 by Salvador FandiEo - -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 7a6848d..db0943c 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 Set up the C<$pager> variable. Adds a pipe to the front unless there's one @@ -7235,7 +7140,6 @@ B I Prints nested parents of given class. B Display current thread id. B Display all thread ids the current one will be identified: . B [I [I]] List lexicals in higher scope . Vars same as B. -B

Something to do with assertions... B<<> ? List Perl commands to run before each prompt. B<<> I 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 --- 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 --- 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 --- 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)) diff --git a/pod/perl.pod b/pod/perl.pod index bf24ed8..15b8106 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -9,7 +9,6 @@ B S<[ B<-sTtuUWX> ]> S<[ B<-cw> ] [ B<-d>[B][:I] ] [ B<-D>[I] ]> S<[ B<-pna> ] [ B<-F>I ] [ B<-l>[I] ] [ B<-0>[I] ]> S<[ B<-I>I

] [ B<-m>[B<->]I ] [ B<-M>[B<->]I<'module...'> ] [ B<-f> ]> - S<[ B<-A>[I][=I] ]> S<[ B<-C [I] >]> S<[ B<-P> ]> S<[ B<-S> ]> diff --git a/pod/perldiag.pod b/pod/perldiag.pod index b5d125f..e118220 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -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 pragma. - =item (in cleanup) %s (W misc) This prefix usually indicates that a DESTROY() method raised diff --git a/pod/perllexwarn.pod b/pod/perllexwarn.pod index 93ec769..bed349f 100644 --- a/pod/perllexwarn.pod +++ b/pod/perllexwarn.pod @@ -212,8 +212,6 @@ The current hierarchy is: all -+ | - +- assertions - | +- closure | +- deprecated diff --git a/pod/perlrun.pod b/pod/perlrun.pod index 7ab7912..a72c2c0 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -9,7 +9,6 @@ B S<[ B<-sTtuUWX> ]> S<[ B<-cw> ] [ B<-d>[B][:I] ] [ B<-D>[I] ]> S<[ B<-pna> ] [ B<-F>I ] [ B<-l>[I] ] [ B<-0>[I] ]> S<[ B<-I>I ] [ B<-m>[B<->]I ] [ B<-M>[B<->]I<'module...'> ] [ B<-f> ]> - S<[ B<-A>[I][=I] ]> S<[ B<-C [I] >]> S<[ B<-P> ]> S<[ B<-S> ]> @@ -260,19 +259,6 @@ format: C<-0xHHH...>, where the C 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][=I]> -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 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 and L. - =item B<-a> X<-a> X diff --git a/pod/perltodo.pod b/pod/perltodo.pod index 48acd2c..6a0d33d 100644 --- a/pod/perltodo.pod +++ b/pod/perltodo.pod @@ -603,15 +603,6 @@ instated. The old perltodo notes "Look at the "reification" code in 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 is a hack - diff --git a/pp_hot.c b/pp_hot.c index 35e8868..27e863d 100644 --- 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 --- 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 index ae25bb8..0000000 --- a/t/comp/assertions.t +++ /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 index 87d175b..0000000 --- a/t/comp/asstcompat.t +++ /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'); diff --git a/t/op/attrs.t b/t/op/attrs.t index 7b20210..04e4517 100644 --- a/t/op/attrs.t +++ b/t/op/attrs.t @@ -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 index 5111b9d..0000000 --- a/t/run/switch_A.t +++ /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 --- 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 diff --git a/warnings.pl b/warnings.pl index d342a39..63cc677 100644 --- a/warnings.pl +++ b/warnings.pl @@ -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 ], }], diff --git a/xsutils.c b/xsutils.c index 4ea4de2..0f8436b 100644 --- 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)) -- 2.7.4