fix handling of registered warning categories

There were some problems arising from some warning bitsets being shorter
than others, which happens when registration of a new warning category
makes new bitsets longer.  Most obviously, if a scope used "use warnings
'all'" to turn on all warnings and then turned off some specific warnings,
then that scope wouldn't get warnings for subsequently-registered warning
categories, because its bitset doesn't extend to the bit controlling
the new category.  (If just "use warnings 'all'" was used, without any
customisation, then a special hack made that work for new categories.)
It was also possible for a longer bitset to get truncated by a warnings
pragma, because the bitset editing code assumed that all bitsets are
the same length.

To fix this, first the warning bits for the "all" category have to change
meaning.  Unlike all other warning categories, the bits for "all" used to
be set only when there were no warning categories disabled; disabling any
would also clear the "all" bits.  That was supporting the special hack
mentioned above that the all-warnings bitset work for new categories.
This exception is now removed, so the meaning of the "all" bits is now the
more obvious meaning, of indicating the default treatment that the scope
wants for warnings not falling into any category known to the bitset.
In warnings::warnif() et al, if the caller's bitset is found to be too
short to have a bit for the relevant category, then the setting for the
"all" category is used instead.

Because the length of a bitset is an integral number of bytes, but
only two bits are used per category, the length of a bitset doesn't
precisely indicate which categories had been registered by the time it
was constructed.  So the standard bitsets for the "all" category are
now always filled to their byte length, with bits set preemptively for
categories not yet registered that fall within the current bitset length.

When a warnings pragma operates on a bitset, it first expands it to the
preferred length, by duplicating the "all" bits for the categories covered
by the new length.  It is careful to maintain the length when combining
the bitset with the standard bitsets for categories.  When a bitset is
read from ${^WARNING_BITS} or from caller(), the standard pWARN_ALL
setting is no longer expanded by the core to $warnings::Bits{all},
because the core's short WARN_ALLstring will now be expanded correctly
just like any other bitset.

Fixes [perl #108778].

8 files changed, 165 insertions, 132 deletions

diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index 833f0a7853..06b5cc7e77 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -1996,7 +1996,7 @@ no warnings "experimental::lexical_subs";
 my sub f {}
 print f();
 >>>>
-BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x15"}
+BEGIN {${^WARNING_BITS} = "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55"}
 my sub f {
     
 }
@@ -2009,7 +2009,7 @@ no warnings 'experimental::lexical_subs';
 state sub f {}
 print f();
 >>>>
-BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x15"}
+BEGIN {${^WARNING_BITS} = "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55"}
 state sub f {
     
 }
diff --git a/lib/warnings.pm b/lib/warnings.pm
index 2ae1bb4e06..64e6448a08 100644
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -5,7 +5,7 @@
 
 package warnings;
 
-our $VERSION = "1.37";
+our $VERSION = "1.38";
 
 # Verify that we're called correctly so that warnings will work.
 # Can't use Carp, since Carp uses us!
@@ -99,7 +99,7 @@ our %Offsets = (
 );
 
 our %Bits = (
-    'all'				=> "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..66]
+    'all'				=> "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..67]
     'ambiguous'				=> "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [29]
     'bareword'				=> "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [30]
     'closed'				=> "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
@@ -169,7 +169,7 @@ our %Bits = (
 );
 
 our %DeadBits = (
-    'all'				=> "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..66]
+    'all'				=> "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..67]
     'ambiguous'				=> "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [29]
     'bareword'				=> "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [30]
     'closed'				=> "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
@@ -244,8 +244,6 @@ our $DEFAULT				=  "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55\x51
 our $LAST_BIT				=  134 ;
 our $BYTES				=  17 ;
 
-our $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
-
 sub Croaker
 {
     require Carp; # this initializes %CarpInternal
@@ -254,12 +252,32 @@ sub Croaker
     Carp::croak(@_);
 }
 
+sub _expand_bits {
+    my $bits = shift;
+    my $want_len = ($LAST_BIT + 7) >> 3;
+    my $len = length($bits);
+    if ($len != $want_len) {
+	if ($bits eq "") {
+	    $bits = "\x00" x $want_len;
+	} elsif ($len > $want_len) {
+	    substr $bits, $want_len, $len-$want_len, "";
+	} else {
+	    my $a = vec($bits, $Offsets{all} >> 1, 2);
+	    $a |= $a << 2;
+	    $a |= $a << 4;
+	    $bits .= chr($a) x ($want_len - $len);
+	}
+    }
+    return $bits;
+}
+
 sub _bits {
     my $mask = shift ;
     my $catmask ;
     my $fatal = 0 ;
     my $no_fatal = 0 ;
 
+    $mask = _expand_bits($mask);
     foreach my $word ( @_ ) {
 	if ($word eq 'FATAL') {
 	    $fatal = 1;
@@ -272,7 +290,7 @@ sub _bits {
 	elsif ($catmask = $Bits{$word}) {
 	    $mask |= $catmask ;
 	    $mask |= $DeadBits{$word} if $fatal ;
-	    $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
+	    $mask = ~(~$mask | $DeadBits{$word}) if $no_fatal ;
 	}
 	else
 	  { Croaker("Unknown warnings category '$word'")}
@@ -285,7 +303,7 @@ sub bits
 {
     # called from B::Deparse.pm
     push @_, 'all' unless @_ ;
-    return _bits(undef, @_) ;
+    return _bits("", @_) ;
 }
 
 sub import
@@ -294,16 +312,12 @@ sub import
 
     my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
 
-    if (vec($mask, $Offsets{'all'}, 1)) {
-	$mask |= $Bits{'all'} ;
-	$mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
-    }
-
-    # append 'all' when implied (after a lone "FATAL" or "NONFATAL")
-    push @_, 'all' if @_==1 && ( $_[0] eq 'FATAL' || $_[0] eq 'NONFATAL' );
+    # append 'all' when implied (empty import list or after a lone
+    # "FATAL" or "NONFATAL")
+    push @_, 'all'
+	if !@_ || (@_==1 && ($_[0] eq 'FATAL' || $_[0] eq 'NONFATAL'));
 
-    # Empty @_ is equivalent to @_ = 'all' ;
-    ${^WARNING_BITS} = @_ ? _bits($mask, @_) : $mask | $Bits{all} ;
+    ${^WARNING_BITS} = _bits($mask, @_);
 }
 
 sub unimport
@@ -313,20 +327,16 @@ sub unimport
     my $catmask ;
     my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
 
-    if (vec($mask, $Offsets{'all'}, 1)) {
-	$mask |= $Bits{'all'} ;
-	$mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
-    }
-
     # append 'all' when implied (empty import list or after a lone "FATAL")
     push @_, 'all' if !@_ || @_==1 && $_[0] eq 'FATAL';
 
+    $mask = _expand_bits($mask);
     foreach my $word ( @_ ) {
 	if ($word eq 'FATAL') {
 	    next;
 	}
 	elsif ($catmask = $Bits{$word}) {
-	    $mask &= ~($catmask | $DeadBits{$word} | $All);
+	    $mask = ~(~$mask | $catmask | $DeadBits{$word});
 	}
 	else
 	  { Croaker("Unknown warnings category '$word'")}
@@ -396,13 +406,13 @@ sub __chk
     my(@callers_bitmask) = (caller($i))[9] ;
     my $callers_bitmask =
 	 @callers_bitmask ? $callers_bitmask[0] // $DEFAULT : 0 ;
+    length($callers_bitmask) > ($offset >> 3) or $offset = $Offsets{all};
 
     my @results;
     foreach my $type (FATAL, NORMAL) {
 	next unless $wanted & $type;
 
-	push @results, (vec($callers_bitmask, $offset + $type - 1, 1) ||
-			vec($callers_bitmask, $Offsets{'all'} + $type - 1, 1));
+	push @results, vec($callers_bitmask, $offset + $type - 1, 1);
     }
 
     # &enabled and &fatal_enabled
@@ -434,14 +444,13 @@ sub register_categories
 
     for my $name (@names) {
 	if (! defined $Bits{$name}) {
-	    $Bits{$name}     = _mkMask($LAST_BIT);
-	    vec($Bits{'all'}, $LAST_BIT, 1) = 1;
-	    $Offsets{$name}  = $LAST_BIT ++;
-	    foreach my $k (keys %Bits) {
-		vec($Bits{$k}, $LAST_BIT, 1) = 0;
+	    $Offsets{$name}  = $LAST_BIT;
+	    $Bits{$name}     = _mkMask($LAST_BIT++);
+	    $DeadBits{$name} = _mkMask($LAST_BIT++);
+	    if (length($Bits{$name}) > length($Bits{all})) {
+		$Bits{all} .= "\x55";
+		$DeadBits{all} .= "\xaa";
 	    }
-	    $DeadBits{$name} = _mkMask($LAST_BIT);
-	    vec($DeadBits{'all'}, $LAST_BIT++, 1) = 1;
 	}
     }
 }
diff --git a/mg.c b/mg.c
index a359ebfcca..fe077550f8 100644
--- a/mg.c
+++ b/mg.c
@@ -1111,14 +1111,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                 goto set_undef;
 	    }
             else if (PL_compiling.cop_warnings == pWARN_ALL) {
-		/* Get the bit mask for $warnings::Bits{all}, because
-		 * it could have been extended by warnings::register */
-		HV * const bits = get_hv("warnings::Bits", 0);
-		SV ** const bits_all = bits ? hv_fetchs(bits, "all", FALSE) : NULL;
-		if (bits_all)
-		    sv_copypv(sv, *bits_all);
-	        else
-		    sv_setpvn(sv, WARN_ALLstring, WARNsize);
+		sv_setpvn(sv, WARN_ALLstring, WARNsize);
 	    }
             else {
 	        sv_setpvn(sv, (char *) (PL_compiling.cop_warnings + 1),
@@ -2909,25 +2902,18 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 		}
 		{
 		    STRLEN len, i;
-		    int accumulate = 0 ;
-		    int any_fatals = 0 ;
-		    const char * const ptr = SvPV_const(sv, len) ;
+		    int not_none = 0, not_all = 0;
+		    const U8 * const ptr = (const U8 *)SvPV_const(sv, len) ;
 		    for (i = 0 ; i < len ; ++i) {
-		        accumulate |= ptr[i] ;
-		        any_fatals |= (ptr[i] & 0xAA) ;
+			not_none |= ptr[i];
+			not_all |= ptr[i] ^ 0x55;
 		    }
-		    if (!accumulate) {
+		    if (!not_none) {
 		        if (!specialWARN(PL_compiling.cop_warnings))
 			    PerlMemShared_free(PL_compiling.cop_warnings);
 			PL_compiling.cop_warnings = pWARN_NONE;
-		    }
-		    /* Yuck. I can't see how to abstract this:  */
-		    else if (isWARN_on(
-                                ((STRLEN *)SvPV_nolen_const(sv)) - 1,
-                                WARN_ALL)
-                            && !any_fatals)
-                    {
-			if (!specialWARN(PL_compiling.cop_warnings))
+		    } else if (len >= WARNsize && !not_all) {
+		        if (!specialWARN(PL_compiling.cop_warnings))
 			    PerlMemShared_free(PL_compiling.cop_warnings);
 	                PL_compiling.cop_warnings = pWARN_ALL;
 	                PL_dowarn |= G_WARN_ONCE ;
diff --git a/pp_ctl.c b/pp_ctl.c
index 7581b37985..bfd81bae4b 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2007,16 +2007,7 @@ PP(pp_caller)
             mask = &PL_sv_undef ;
         else if (old_warnings == pWARN_ALL ||
 		  (old_warnings == pWARN_STD && PL_dowarn & G_WARN_ON)) {
-	    /* Get the bit mask for $warnings::Bits{all}, because
-	     * it could have been extended by warnings::register */
-	    SV **bits_all;
-	    HV * const bits = get_hv("warnings::Bits", 0);
-	    if (bits && (bits_all=hv_fetchs(bits, "all", FALSE))) {
-		mask = newSVsv(*bits_all);
-	    }
-	    else {
-		mask = newSVpvn(WARN_ALLstring, WARNsize) ;
-	    }
+	    mask = newSVpvn(WARN_ALLstring, WARNsize) ;
 	}
         else
             mask = newSVpvn((char *) (old_warnings + 1), old_warnings[0]);
diff --git a/regen/warnings.pl b/regen/warnings.pl
index 5721c17b26..b9692ab5ea 100644
--- a/regen/warnings.pl
+++ b/regen/warnings.pl
@@ -16,7 +16,7 @@
 #
 # This script is normally invoked from regen.pl.
 
-$VERSION = '1.37';
+$VERSION = '1.38';
 
 BEGIN {
     require './regen/regen_lib.pl';
@@ -338,6 +338,9 @@ Too many warnings categories -- max is 255
 EOM
 
   walk ($tree) ;
+  for (my $i = $index; $i & 3; $i++) {
+      push @{$list{all}}, $i;
+  }
 
   $index *= 2 ;
   $warn_size = int($index / 8) + ($index % 8 != 0) ;
@@ -462,13 +465,15 @@ is by default enabled even if not within the scope of S<C<use warnings>>.
 #define unpackWARN4(x)		(((x) >>24) & 0xFF)
 
 #define ckDEAD(x)							\
-	   (PL_curcop &&                                                \
-            !specialWARN(PL_curcop->cop_warnings) &&			\
-	    ( isWARNf_on(PL_curcop->cop_warnings, WARN_ALL) || 		\
-	      isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) ||	\
-	      isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) ||	\
-	      isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) ||	\
-	      isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x))))
+   (PL_curcop &&                                                        \
+    !specialWARN(PL_curcop->cop_warnings) &&			        \
+    (isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) ||	        \
+      (unpackWARN2(x) &&                                                \
+	(isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) ||	        \
+	  (unpackWARN3(x) &&                                            \
+	    (isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) ||	\
+	      (unpackWARN4(x) &&                                        \
+		isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x)))))))))
 
 /* end of file warnings.h */
 EOM
@@ -561,8 +566,6 @@ die sprintf "Incorrect use of pragma '%s' at %s line %d.\n", __PACKAGE__, +(call
 
 KEYWORDS
 
-our $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
-
 sub Croaker
 {
     require Carp; # this initializes %CarpInternal
@@ -571,12 +574,32 @@ sub Croaker
     Carp::croak(@_);
 }
 
+sub _expand_bits {
+    my $bits = shift;
+    my $want_len = ($LAST_BIT + 7) >> 3;
+    my $len = length($bits);
+    if ($len != $want_len) {
+	if ($bits eq "") {
+	    $bits = "\x00" x $want_len;
+	} elsif ($len > $want_len) {
+	    substr $bits, $want_len, $len-$want_len, "";
+	} else {
+	    my $a = vec($bits, $Offsets{all} >> 1, 2);
+	    $a |= $a << 2;
+	    $a |= $a << 4;
+	    $bits .= chr($a) x ($want_len - $len);
+	}
+    }
+    return $bits;
+}
+
 sub _bits {
     my $mask = shift ;
     my $catmask ;
     my $fatal = 0 ;
     my $no_fatal = 0 ;
 
+    $mask = _expand_bits($mask);
     foreach my $word ( @_ ) {
 	if ($word eq 'FATAL') {
 	    $fatal = 1;
@@ -589,7 +612,7 @@ sub _bits {
 	elsif ($catmask = $Bits{$word}) {
 	    $mask |= $catmask ;
 	    $mask |= $DeadBits{$word} if $fatal ;
-	    $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
+	    $mask = ~(~$mask | $DeadBits{$word}) if $no_fatal ;
 	}
 	else
 	  { Croaker("Unknown warnings category '$word'")}
@@ -602,7 +625,7 @@ sub bits
 {
     # called from B::Deparse.pm
     push @_, 'all' unless @_ ;
-    return _bits(undef, @_) ;
+    return _bits("", @_) ;
 }
 
 sub import
@@ -611,16 +634,12 @@ sub import
 
     my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
 
-    if (vec($mask, $Offsets{'all'}, 1)) {
-	$mask |= $Bits{'all'} ;
-	$mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
-    }
-
-    # append 'all' when implied (after a lone "FATAL" or "NONFATAL")
-    push @_, 'all' if @_==1 && ( $_[0] eq 'FATAL' || $_[0] eq 'NONFATAL' );
+    # append 'all' when implied (empty import list or after a lone
+    # "FATAL" or "NONFATAL")
+    push @_, 'all'
+	if !@_ || (@_==1 && ($_[0] eq 'FATAL' || $_[0] eq 'NONFATAL'));
 
-    # Empty @_ is equivalent to @_ = 'all' ;
-    ${^WARNING_BITS} = @_ ? _bits($mask, @_) : $mask | $Bits{all} ;
+    ${^WARNING_BITS} = _bits($mask, @_);
 }
 
 sub unimport
@@ -630,20 +649,16 @@ sub unimport
     my $catmask ;
     my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
 
-    if (vec($mask, $Offsets{'all'}, 1)) {
-	$mask |= $Bits{'all'} ;
-	$mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
-    }
-
     # append 'all' when implied (empty import list or after a lone "FATAL")
     push @_, 'all' if !@_ || @_==1 && $_[0] eq 'FATAL';
 
+    $mask = _expand_bits($mask);
     foreach my $word ( @_ ) {
 	if ($word eq 'FATAL') {
 	    next;
 	}
 	elsif ($catmask = $Bits{$word}) {
-	    $mask &= ~($catmask | $DeadBits{$word} | $All);
+	    $mask = ~(~$mask | $catmask | $DeadBits{$word});
 	}
 	else
 	  { Croaker("Unknown warnings category '$word'")}
@@ -713,13 +728,13 @@ sub __chk
     my(@callers_bitmask) = (caller($i))[9] ;
     my $callers_bitmask =
 	 @callers_bitmask ? $callers_bitmask[0] // $DEFAULT : 0 ;
+    length($callers_bitmask) > ($offset >> 3) or $offset = $Offsets{all};
 
     my @results;
     foreach my $type (FATAL, NORMAL) {
 	next unless $wanted & $type;
 
-	push @results, (vec($callers_bitmask, $offset + $type - 1, 1) ||
-			vec($callers_bitmask, $Offsets{'all'} + $type - 1, 1));
+	push @results, vec($callers_bitmask, $offset + $type - 1, 1);
     }
 
     # &enabled and &fatal_enabled
@@ -751,14 +766,13 @@ sub register_categories
 
     for my $name (@names) {
 	if (! defined $Bits{$name}) {
-	    $Bits{$name}     = _mkMask($LAST_BIT);
-	    vec($Bits{'all'}, $LAST_BIT, 1) = 1;
-	    $Offsets{$name}  = $LAST_BIT ++;
-	    foreach my $k (keys %Bits) {
-		vec($Bits{$k}, $LAST_BIT, 1) = 0;
+	    $Offsets{$name}  = $LAST_BIT;
+	    $Bits{$name}     = _mkMask($LAST_BIT++);
+	    $DeadBits{$name} = _mkMask($LAST_BIT++);
+	    if (length($Bits{$name}) > length($Bits{all})) {
+		$Bits{all} .= "\x55";
+		$DeadBits{all} .= "\xaa";
 	    }
-	    $DeadBits{$name} = _mkMask($LAST_BIT);
-	    vec($DeadBits{'all'}, $LAST_BIT++, 1) = 1;
 	}
     }
 }
diff --git a/t/lib/warnings/9enabled b/t/lib/warnings/9enabled
index 60b7c48da3..872e48a1b9 100644
--- a/t/lib/warnings/9enabled
+++ b/t/lib/warnings/9enabled
@@ -883,10 +883,10 @@ def abc43 enabled
 def all enabled
 abc43 self not enabled
 abc43 def enabled
-abc43 all not enabled
+abc43 all enabled
 def self enabled
 def abc43 not enabled
-def all not enabled
+def all enabled
 ########
 -w
 --FILE-- abc44.pm
@@ -1291,7 +1291,7 @@ ok2
 --FILE-- fatal4.pm
 package fatal4 ;
 no warnings ;
-print "ok1\n" if !warnings::fatal_enabled('all') ;
+print "ok1\n" if warnings::fatal_enabled('all') ;
 print "ok2\n" if warnings::fatal_enabled("void") ;
 print "ok3\n" if !warnings::fatal_enabled("syntax") ;
 1;
@@ -1302,3 +1302,52 @@ EXPECT
 ok1
 ok2
 ok3
+########
+{ Quux::quux(); }
+{ no warnings; Quux::quux(); }
+{ no warnings; use warnings "void"; Quux::quux(); }
+{ use warnings; Quux::quux(); }
+{ use warnings; no warnings "void"; Quux::quux(); }
+use warnings ();
+BEGIN { warnings::register_categories(qw(wibble wobble wabble wubble)); }
+package Quux {
+  sub quux {
+    warnings::warnif($_, "My $_ is flanged")
+      foreach qw(wibble wobble wabble wubble);
+    ();
+  }
+}
+{ Quux::quux(); }
+{ no warnings; Quux::quux(); }
+{ no warnings; use warnings "void"; Quux::quux(); }
+{ use warnings; Quux::quux(); }
+{ use warnings; no warnings "void"; Quux::quux(); }
+{ no warnings; use warnings qw(wibble wabble); Quux::quux(); }
+{ no warnings; use warnings qw(wobble wubble); Quux::quux(); }
+{ use warnings; no warnings qw(wibble wabble); Quux::quux(); }
+{ use warnings; no warnings qw(wobble wubble); Quux::quux(); }
+EXPECT
+My wibble is flanged at - line 4.
+My wobble is flanged at - line 4.
+My wabble is flanged at - line 4.
+My wubble is flanged at - line 4.
+My wibble is flanged at - line 5.
+My wobble is flanged at - line 5.
+My wabble is flanged at - line 5.
+My wubble is flanged at - line 5.
+My wibble is flanged at - line 18.
+My wobble is flanged at - line 18.
+My wabble is flanged at - line 18.
+My wubble is flanged at - line 18.
+My wibble is flanged at - line 19.
+My wobble is flanged at - line 19.
+My wabble is flanged at - line 19.
+My wubble is flanged at - line 19.
+My wibble is flanged at - line 20.
+My wabble is flanged at - line 20.
+My wobble is flanged at - line 21.
+My wubble is flanged at - line 21.
+My wobble is flanged at - line 22.
+My wubble is flanged at - line 22.
+My wibble is flanged at - line 23.
+My wabble is flanged at - line 23.
diff --git a/t/op/caller.t b/t/op/caller.t
index 1ffb5b3443..564d140cc0 100644
--- a/t/op/caller.t
+++ b/t/op/caller.t
@@ -5,7 +5,7 @@ BEGIN {
     chdir 't' if -d 't';
     require './test.pl';
     set_up_inc('../lib');
-    plan( tests => 100 ); # some tests are run in a BEGIN block
+    plan( tests => 97 ); # some tests are run in a BEGIN block
 }
 
 my @c;
@@ -99,31 +99,13 @@ sub testwarn {
 
 {
     no warnings;
-    # Build the warnings mask dynamically
-    my ($default, $registered);
-    BEGIN {
-	for my $i (0..$warnings::LAST_BIT/2 - 1) {
-	    vec($default, $i, 2) = 1;
-	}
-	$registered = $default;
-	vec($registered, $warnings::LAST_BIT/2, 2) = 1;
-    }
-
     BEGIN { check_bits( ${^WARNING_BITS}, "\0" x $warnings::BYTES, 'all bits off via "no warnings"' ) }
     testwarn("\0" x $warnings::BYTES, 'no bits');
 
     use warnings;
-    BEGIN { check_bits( ${^WARNING_BITS}, $default,
+    BEGIN { check_bits( ${^WARNING_BITS}, "\x55" x $warnings::BYTES,
 			'default bits on via "use warnings"' ); }
-    BEGIN { testwarn($default, 'all'); }
-    # run-time :
-    # the warning mask has been extended by warnings::register
-    testwarn($registered, 'ahead of w::r');
-
-    use warnings::register;
-    BEGIN { check_bits( ${^WARNING_BITS}, $registered,
-			'warning bits on via "use warnings::register"' ) }
-    testwarn($registered, 'following w::r');
+    testwarn("\x55" x $warnings::BYTES, 'all');
 }
 
 
diff --git a/warnings.h b/warnings.h
index 01668377fc..c2831a2938 100644
--- a/warnings.h
+++ b/warnings.h
@@ -221,13 +221,15 @@ is by default enabled even if not within the scope of S<C<use warnings>>.
 #define unpackWARN4(x)		(((x) >>24) & 0xFF)
 
 #define ckDEAD(x)							\
-	   (PL_curcop &&                                                \
-            !specialWARN(PL_curcop->cop_warnings) &&			\
-	    ( isWARNf_on(PL_curcop->cop_warnings, WARN_ALL) || 		\
-	      isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) ||	\
-	      isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) ||	\
-	      isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) ||	\
-	      isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x))))
+   (PL_curcop &&                                                        \
+    !specialWARN(PL_curcop->cop_warnings) &&			        \
+    (isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) ||	        \
+      (unpackWARN2(x) &&                                                \
+	(isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) ||	        \
+	  (unpackWARN3(x) &&                                            \
+	    (isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) ||	\
+	      (unpackWARN4(x) &&                                        \
+		isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x)))))))))
 
 /* end of file warnings.h */