diff options
| -rw-r--r-- | lib/assertions.pm | 32 | ||||
| -rw-r--r-- | op.c | 11 | ||||
| -rw-r--r-- | perl.h | 6 |
3 files changed, 28 insertions, 21 deletions
diff --git a/lib/assertions.pm b/lib/assertions.pm index 6bf131d2ac..6c5c211b27 100644 --- a/lib/assertions.pm +++ b/lib/assertions.pm @@ -1,12 +1,12 @@ package assertions; -our $VERSION = '0.03'; +our $VERSION = '0.04'; # use strict; # use warnings; -my $hint=0x01000000; -my $seen_hint=0x02000000; +my $hint = 1; +my $seen_hint = 2; sub _syntax_error ($$) { my ($expr, $why)=@_; @@ -67,10 +67,10 @@ sub _calc_expr { shift @op; } elsif ($t eq '_') { - unless ($^H & $seen_hint) { + unless ($^H{assertions} & $seen_hint) { _carp "assertion status '_' referenced but not previously defined"; } - $t=($^H & $hint) ? 1 : 0; + $t=($^H{assertions} & $hint) ? 1 : 0; } elsif ($t ne '0' and $t ne '1') { $t = ( grep { ref $_ eq 'Regexp' @@ -109,44 +109,44 @@ sub import { foreach my $expr (@_) { unless (_calc_expr $expr) { # print STDERR "assertions deactived"; - $^H &= ~$hint; - $^H |= $seen_hint; + $^H{assertions} &= ~$hint; + $^H{assertions} |= $seen_hint; return; } } # print STDERR "assertions actived"; - $^H |= $hint|$seen_hint; + $^H{assertions} |= $hint|$seen_hint; } sub unimport { @_ > 1 and _carp($_[0]."->unimport arguments are being ignored"); - $^H &= ~$hint; + $^H{assertions} &= ~$hint; } sub enabled { if (@_) { if ($_[0]) { - $^H |= $hint; + $^H{assertions} |= $hint; } else { - $^H &= ~$hint; + $^H{assertions} &= ~$hint; } - $^H |= $seen_hint; + $^H{assertions} |= $seen_hint; } - return $^H & $hint ? 1 : 0; + return $^H{assertions} & $hint ? 1 : 0; } sub seen { if (@_) { if ($_[0]) { - $^H |= $seen_hint; + $^H{assertions} |= $seen_hint; } else { - $^H &= ~$seen_hint; + $^H{assertions} &= ~$seen_hint; } } - return $^H & $seen_hint ? 1 : 0; + return $^H{assertions} & $seen_hint ? 1 : 0; } 1; @@ -7326,13 +7326,20 @@ Perl_ck_subr(pTHX_ OP *o) proto_end = proto + len; } if (CvASSERTION(cv)) { - if (PL_hints & HINT_ASSERTING) { + 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 (!(PL_hints & HINT_ASSERTIONSSEEN) && ckWARN(WARN_ASSERTIONS)) { + if (!(asserthints & HINT_ASSERTIONSSEEN) && ckWARN(WARN_ASSERTIONS)) { Perl_warner(aTHX_ packWARN(WARN_ASSERTIONS), "Impossible to activate assertion call"); } @@ -4281,9 +4281,9 @@ enum { /* pass one of these to get_vtbl */ #define HINT_FILETEST_ACCESS 0x00400000 /* filetest pragma */ #define HINT_UTF8 0x00800000 /* utf8 pragma */ -/* assertions pragma */ -#define HINT_ASSERTING 0x01000000 -#define HINT_ASSERTIONSSEEN 0x02000000 +/* 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 */ |