Change 18828 by [EMAIL PROTECTED] on 2003/03/04 20:49:59
Subject: [PATCH] assertions
From: Salvador Fandi�o <[EMAIL PROTECTED]>
Date: Fri, 21 Feb 2003 17:26:16 +0000
Message-ID: <[EMAIL PROTECTED]>
and the complement : (with added comments)
Subject: [PATCH] bug in ext/B/t/deparse.t
Message-ID: <[EMAIL PROTECTED]>
plus perldiag.pod patch for the new warning
(previous change was, once again, empty)
Affected files ...
... //depot/perl/ext/B/t/deparse.t#8 edit
... //depot/perl/lib/assertions.pm#5 edit
... //depot/perl/lib/assertions/activate.pm#5 edit
... //depot/perl/lib/perl5db.pl#95 edit
... //depot/perl/lib/warnings.pm#27 edit
... //depot/perl/op.c#549 edit
... //depot/perl/perl.h#495 edit
... //depot/perl/perlapi.c#136 edit
... //depot/perl/pod/perldiag.pod#329 edit
... //depot/perl/warnings.h#21 edit
... //depot/perl/warnings.pl#30 edit
Differences ...
==== //depot/perl/ext/B/t/deparse.t#8 (text) ====
Index: perl/ext/B/t/deparse.t
--- perl/ext/B/t/deparse.t#7~18827~ Tue Mar 4 12:48:09 2003
+++ perl/ext/B/t/deparse.t Tue Mar 4 12:49:59 2003
@@ -25,7 +25,12 @@
# Tell B::Deparse about our ambient pragmas
{ my ($hint_bits, $warning_bits);
- BEGIN {($hint_bits, $warning_bits) = ($^H, ${^WARNING_BITS})}
+ # Note: there used to be ${^WARNING_BITS} here, instead of
+ # warnings::bits('all'), but this doesn't work, as ${^WARNING_BITS} is
+ # supposed to be the set of warnings this code has been compiled with, and
+ # later in this test we include modules that themselves use warnings::register
+ # (thus modyfing the warnings mask).
+ BEGIN { ($hint_bits, $warning_bits) = ($^H, warnings::bits('all')); }
$deparse->ambient_pragmas (
hint_bits => $hint_bits,
warning_bits => $warning_bits,
==== //depot/perl/lib/assertions.pm#5 (text) ====
Index: perl/lib/assertions.pm
--- perl/lib/assertions.pm#4~18827~ Tue Mar 4 12:48:09 2003
+++ perl/lib/assertions.pm Tue Mar 4 12:49:59 2003
@@ -6,6 +6,7 @@
# use warnings;
my $hint=0x01000000;
+my $seen_hint=0x02000000;
sub syntax_error ($$) {
my ($expr, $why)[EMAIL PROTECTED];
@@ -13,6 +14,15 @@
Carp::croak("syntax error on assertion filter '$expr' ($why)");
}
+sub my_warn ($) {
+ my $error=shift;
+ require warnings;
+ if (warnings::enabled('assertions')) {
+ require Carp;
+ Carp::carp($error);
+ }
+}
+
sub calc_expr {
my $expr=shift;
my @tokens=split / \s*
@@ -30,6 +40,8 @@
my @op='start';
for my $t (@tokens) {
+ next if (!defined $t or $t eq '');
+
if ($t eq '(') {
unshift @now, 1;
unshift @op, 'start';
@@ -45,9 +57,6 @@
and syntax_error $expr, 'consecutive operators';
$op[0]='&&';
}
- elsif (!defined $t or $t eq '') {
- # warn "empty token";
- }
else {
if ($t eq ')') {
@now==1 and
@@ -59,6 +68,9 @@
shift @op;
}
elsif ($t eq '_') {
+ unless ($^H & $seen_hint) {
+ my_warn "assertion status '_' referenced but not previously
defined";
+ }
$t=($^H & $hint) ? 1 : 0;
}
elsif ($t ne '0' and $t ne '1') {
@@ -98,11 +110,12 @@
unless (calc_expr $expr) {
# print STDERR "assertions deactived";
$^H &= ~$hint;
+ $^H |= $seen_hint;
return;
}
}
# print STDERR "assertions actived";
- $^H |= $hint;
+ $^H |= $hint|$seen_hint;
}
==== //depot/perl/lib/assertions/activate.pm#5 (text) ====
Index: perl/lib/assertions/activate.pm
--- perl/lib/assertions/activate.pm#4~18827~ Tue Mar 4 12:48:09 2003
+++ perl/lib/assertions/activate.pm Tue Mar 4 12:49:59 2003
@@ -8,7 +8,7 @@
sub import {
shift;
@_='.*' unless @_;
- push @{^ASSERTING}, ( map { qr/^$_$/ } @_) ;
+ push @{^ASSERTING}, ( map { qr/^(?:$_)$/ } @_) ;
}
1;
==== //depot/perl/lib/perl5db.pl#95 (text) ====
Index: perl/lib/perl5db.pl
--- perl/lib/perl5db.pl#94~18827~ Tue Mar 4 12:48:09 2003
+++ perl/lib/perl5db.pl Tue Mar 4 12:49:59 2003
@@ -332,18 +332,11 @@
# test if assertions are supported and actived:
BEGIN {
$ini_assertion=
- eval "sub asserting_test : assertion {1}; asserting_test()";
+ eval "sub asserting_test : assertion {1}; 1";
# $ini_assertion = undef => assertions unsupported,
- # " = 0 => assertions supported but inactive
- # " = 1 => assertions suported and active
+ # " = 1 => assertions suported
# print "\$ini_assertion=$ini_assertion\n";
}
-INIT { # We use also INIT {} because test doesn't work in BEGIN {} if
- # '-A' flag is in the perl script source file after the shebang
- # as in '#!/usr/bin/perl -A'
- $ini_assertion=
- eval "sub asserting_test1 : assertion {1}; asserting_test1()";
-}
local($^W) = 0; # Switch run-time warnings off during init.
warn ( # Do not ;-)
@@ -1001,7 +994,10 @@
print $OUT "Warning: some settings and command-line options
may be lost!\n";
my (@script, @flags, $cl);
push @flags, '-w' if $ini_warn;
- push @flags, '-A' if $ini_assertion;
+ if ($ini_assertion and @{^ASSERTING}) {
+ push @flags, (map { /\:\^\(\?\:(.*)\)\$\)/ ?
+ "-A$1" : "-A$_" } @{^ASSERTING});
+ }
# Put all the old includes at the start to get
# the same debugger.
for (@ini_INC) {
@@ -2630,23 +2626,23 @@
&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");
+ unless (defined $ini_assertion) {
+ if ($term) {
+ &warn("Current Perl interpreter doesn't support assertions");
+ }
+ return 0;
}
- return 0;
- }
- if (shift) {
- unless ($ini_assertion) {
- print "Assertions will also be actived on next 'R'!\n";
- $ini_assertion=1;
+ 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};
- $^P|=$DollarCaretP_flags{PERLDBf_ASSERTION};
- }
- else {
- $^P|=$DollarCaretP_flags{PERLDBf_SUB};
- }
}
!($^P & $DollarCaretP_flags{PERLDBf_SUB}) || 0;
}
==== //depot/perl/lib/warnings.pm#27 (text+w) ====
Index: perl/lib/warnings.pm
--- perl/lib/warnings.pm#26~18827~ Tue Mar 4 12:48:09 2003
+++ perl/lib/warnings.pm Tue Mar 4 12:49:59 2003
@@ -180,11 +180,16 @@
'utf8' => 88,
'void' => 90,
'y2k' => 92,
+
+ # Warnings Categories added in Perl 5.009
+
+ 'assertions' => 94,
);
%Bits = (
- 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", #
[0..46]
+ 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", #
[0..47]
'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00",
# [29]
+ 'assertions' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [47]
'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
@@ -233,8 +238,9 @@
);
%DeadBits = (
- 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", #
[0..46]
+ 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", #
[0..47]
'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00",
# [29]
+ 'assertions' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [47]
'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
@@ -283,7 +289,7 @@
);
$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
-$LAST_BIT = 94 ;
+$LAST_BIT = 96 ;
$BYTES = 12 ;
$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
==== //depot/perl/op.c#549 (text) ====
Index: perl/op.c
--- perl/op.c#548~18827~ Tue Mar 4 12:48:09 2003
+++ perl/op.c Tue Mar 4 12:49:59 2003
@@ -5814,7 +5814,13 @@
if (PERLDB_ASSERTION && PL_curstash != PL_debstash)
o->op_private |= OPpENTERSUB_DB;
}
- else delete=1;
+ else {
+ delete=1;
+ if (ckWARN(WARN_ASSERTIONS) && !(PL_hints &
HINT_ASSERTIONSSEEN)) {
+ Perl_warner(aTHX_ packWARN(WARN_ASSERTIONS),
+ "Impossible to activate assertion call");
+ }
+ }
}
}
}
==== //depot/perl/perl.h#495 (text) ====
Index: perl/perl.h
--- perl/perl.h#494~18827~ Tue Mar 4 12:48:09 2003
+++ perl/perl.h Tue Mar 4 12:49:59 2003
@@ -3241,7 +3241,9 @@
#define HINT_FILETEST_ACCESS 0x00400000 /* filetest pragma */
#define HINT_UTF8 0x00800000 /* utf8 pragma */
+/* assertions pragma */
#define HINT_ASSERTING 0x01000000
+#define HINT_ASSERTIONSSEEN 0x02000000
/* The following are stored in $sort::hints, not in PL_hints */
#define HINT_SORT_SORT_BITS 0x000000FF /* allow 256 different ones */
==== //depot/perl/perlapi.c#136 (text+w) ====
Index: perl/perlapi.c
--- perl/perlapi.c#135~18827~ Tue Mar 4 12:48:09 2003
+++ perl/perlapi.c Tue Mar 4 12:49:59 2003
@@ -1,7 +1,7 @@
/*
* perlapi.c
*
- * Copyright (c) 1997-2002, Larry Wall
+ * Copyright (c) 1997-2003, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
==== //depot/perl/pod/perldiag.pod#329 (text) ====
Index: perl/pod/perldiag.pod
--- perl/pod/perldiag.pod#328~18827~ Tue Mar 4 12:48:09 2003
+++ perl/pod/perldiag.pod Tue Mar 4 12:49:59 2003
@@ -1770,6 +1770,11 @@
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
==== //depot/perl/warnings.h#21 (text+w) ====
Index: perl/warnings.h
--- perl/warnings.h#20~18827~ Tue Mar 4 12:48:09 2003
+++ perl/warnings.h Tue Mar 4 12:49:59 2003
@@ -73,6 +73,10 @@
#define WARN_VOID 45
#define WARN_Y2K 46
+/* Warnings Categories added in Perl 5.009 */
+
+#define WARN_ASSERTIONS 47
+
#define WARNsize 12
#define WARN_ALLstring "\125\125\125\125\125\125\125\125\125\125\125\125"
#define WARN_NONEstring "\0\0\0\0\0\0\0\0\0\0\0\0"
==== //depot/perl/warnings.pl#30 (text) ====
Index: perl/warnings.pl
--- perl/warnings.pl#29~18827~ Tue Mar 4 12:48:09 2003
+++ perl/warnings.pl Tue Mar 4 12:49:59 2003
@@ -63,6 +63,8 @@
'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 ],
}],
} ;
End of Patch.
