Use %^H instead of $^H for the assertions pragma

p4raw-id: //depot/perl@28808

diff --git a/lib/assertions.pm b/lib/assertions.pm
index 6bf131d..6c5c211 100644 (file)
--- 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;

diff --git a/op.c b/op.c
index 1e16606..8872764 100644 (file)
--- a/op.c
+++ b/op.c
@@ -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");
                        }

diff --git a/perl.h b/perl.h
index 665324a..9ae17aa 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -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 */