perl inadvertently destroys signal handlers as of f746176000

[p5pRT]

Migrated from rt.perl.org#76138 (status was 'resolved')

Searchable as RT76138$

[p5pRT]

From @avar

As of f746176 (Bareword sub lookups) by Zefram there's a regression
in how perl handles signals​:

After f746176​:

  $ echo 'package Moo;sub x {Y​::SIG->z};1' > /tmp/Moo.pm; perl -le'print $]; @​INC = "/tmp"; $SIG{INT} = sub { warn "foo\n" }; require Moo; sleep 30'
  5.013002
  ^CSignal SIGINT received, but no signal handler set.

Before​:

  $ echo 'package Moo;sub x {Y​::SIG->z};1' > /tmp/Moo.pm; /usr/bin/perl -le'print $]; @​INC = "/tmp"; $SIG{INT} = sub { warn "foo\n" }; require Moo; sleep 30'
  5.010001
  ^Cfoo

Compiling Y​::SIG->z is inadvertently overwriting %SIG. This might also
apply to some other symbols, but didn't with @​INC and %ENV when I
tried them.

This bug was discovered in the wild when using signal handlers with
Net​::DNS. When 'Net​::DNS​::RR​::SIG->create..' was compiled the user's
signal handler was destroyed​:
 
  lib/Net/DNS/Packet.pm
  677​:SIG0 support is provided through the Net​::DNS​::RR​::SIG class. This class is not part
  685​:SIG0 support is experimental see Net​::DNS​::RR​::SIG for details.
  687​:The method will call C<Carp​::croak()> if Net​::DNS​::RR​::SIG cannot be found.
  701​: if ( UNIVERSAL​::isa($arg,'Net​::DNS​::RR​::SIG') ) {
  705​: $sig0 = Net​::DNS​::RR​::SIG->create('', $arg);
  707​: } elsif ( UNIVERSAL​::isa($arg,'Net​::DNS​::RR​::SIG​::Private') ) {
  709​: $sig0 = Net​::DNS​::RR​::SIG->create('', $arg);
  717​: $sig0 = Net​::DNS​::RR​::SIG->create('', $arg);

[p5pRT]

From zefram@fysh.org

??var Arnfj??r?? Bjarmason wrote​:

As of f746176 (Bareword sub lookups) by Zefram there's a regression
in how perl handles signals​:

Turns out this commit is not actually introducing a new bug. It's making
an old bug happen in more circumstances than previously. Here's a
shorter test for the new situation​:

$ perl5.13.3 -lwe '$SIG{ALRM} = sub { warn "OK\n" }; eval "sub x {Y​::SIG->z};1"; alarm 1; sleep 2'
Signal SIGALRM received, but no signal handler set.
$ perl5.10.1 -lwe '$SIG{ALRM} = sub { warn "OK\n" }; eval "sub x {Y​::SIG->z};1"; alarm 1; sleep 2'
OK

And here's the equivalent test for a closely related situation​:

$ perl5.13.3 -lwe '$SIG{ALRM} = sub { warn "OK\n" }; eval "sub x {\@​Y​::SIG->z};1"; alarm 1; sleep 2'
Signal SIGALRM received, but no signal handler set.
$ perl5.10.1 -lwe '$SIG{ALRM} = sub { warn "OK\n" }; eval "sub x {\@​Y​::SIG->z};1"; alarm 1; sleep 2'
Signal SIGALRM received, but no signal handler set.
$ perl5.004 -lwe '$SIG{ALRM} = sub { warn "OK\n" }; eval "sub x {\@​Y​::SIG->z};1"; alarm 1; sleep 2'
Signal SIGALRM received, but no signal handler set.

-zefram

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

From @cpansprout

This script should make the bug abundantly clear​:

@​a'SIG{<INT HUB>} = <another Not>;
@​b'SIG{<TERM AMP KILL>} = <hacker Yes, Perl>;
@​ != qw \! ? \; $ \= "\n";
for$%(a,b){print join(q q q,map ${"$%​::SIG"}{$_}
=~/([^R​:]{2,})\z/,sort keys%{"$%​::SIG"}),pop@​!}

Perl_gv_fetchpvn_flags is the culprit. It doesn�t take the package name into account when attaching magic to variables based on their names.

When *SIG is created, undef is assigned to all the elements of %SIG that correspond to signals, so that keys %SIG will work. That�s why the signal handlers are wiped.

Now, if we turn on the magic for %SIG, $!, etc. only when they are in the main package, how much code would break? There are several dozen variables like this. Yet I don�t think anyone is seriously using

open FH, $file or die ${"'Oh no'!"}

But you never know.... :-)

I could fix this either by making the %SIG initialisation less destructive (have it check whether each elem exists before assigning undef). Or I could stop all this magic from leaking into packages other than main (except for %OVERLOAD, etc.), breaking the JAPH above. Which is preferable?

[p5pRT]

From @rgarcia

On 1 August 2010 21​:08, Father Chrysostomos <sprout@​cpan.org> wrote​:

I could fix this either by making the %SIG initialisation less destructive (have it check whether each elem exists before assigning undef). Or I could stop all this magic from leaking into packages other than main (except for %OVERLOAD, etc.), breaking the JAPH above. Which is preferable?

I'd favor the second one, since unqualified %SIG is forced into main​:: anyway.

[p5pRT]

From @obra

On Mon, Aug 09, 2010 at 12​:03​:33PM +0200, Rafael Garcia-Suarez wrote​:

On 1 August 2010 21​:08, Father Chrysostomos <sprout@​cpan.org> wrote​:

I could fix this either by making the %SIG initialisation less destructive (have it check whether each elem exists before assigning undef). Or I could stop all this magic from leaking into packages other than main (except for %OVERLOAD, etc.), breaking the JAPH above. Which is preferable?

I'd favor the second one, since unqualified %SIG is forced into main​:: anyway.

I'm a little bit concerned about breaking that bit of bugward
compatibility, but if we're going to do it, it would make sense to try
it earlier (nowish) in the blead cycle and step it back than to wait
until the last minute.

Other comments from the peanut gallery?

--

[p5pRT]

From @cpansprout

On Aug 9, 2010, at 11​:13 AM, Jesse Vincent wrote​:

On Mon, Aug 09, 2010 at 12​:03​:33PM +0200, Rafael Garcia-Suarez wrote​:

On 1 August 2010 21​:08, Father Chrysostomos <sprout@​cpan.org> wrote​:

I could fix this either by making the %SIG initialisation less destructive (have it check whether each elem exists before assigning undef). Or I could stop all this magic from leaking into packages other than main (except for %OVERLOAD, etc.), breaking the JAPH above. Which is preferable?

I'd favor the second one, since unqualified %SIG is forced into main​:: anyway.

I'm a little bit concerned about breaking that bit of bugward
compatibility,

It probably wonâ��t be the first time Iâ��ve regretted fixing a bug. :-) Try running this in 5.8​:

$_ = "\n,rekcah lreP rehtona tsuJ"; sub a{chop}
print "${[bless[]]}[0]->a . reverse $_";

(B​::Deparse is no help in deciphering it.)

but if we're going to do it, it would make sense to try
it earlier (nowish) in the blead cycle and step it back than to wait
until the last minute.

Here�s a patch. All tests pass, except for cpan/CGI/t/http.t, which always fails. Attached also is a file with perldelta entries.

The diff may be a bit confusing. I moved the cases for ISA and OVERLOAD up into a new switch block that only applies to packages other than main. diff found a different way of looking at it.

For posterity, every test in leaky-magic.t fails without the gv.c changes, except for qw< %! %+ %- $/ $​: $0 >, which seem to be unaffected by this bug.

Hereâ��s a commit message​:

Stop magic applied to $!, %SIG, et al. from applying to similarly-named variables in other packages.

[p5pRT]

From @cpansprout

Inline Patch

diff -Nup blead/MANIFEST blead-76138-clobbered-SIG/MANIFEST
--- blead/MANIFEST	2010-08-02 07:44:14.000000000 -0700
+++ blead-76138-clobbered-SIG/MANIFEST	2010-08-09 23:13:53.000000000 -0700
@@ -4492,6 +4492,7 @@ t/op/join.t			See if join works
 t/op/kill0.t			See if kill(0, $pid) works
 t/op/lc.t			See if lc, uc, lcfirst, ucfirst, quotemeta work
 t/op/lc_user.t			See if user-defined lc et alia work
+t/op/leaky-magic.t		See whether vars' magic leaks into packages
 t/op/length.t			See if length works
 t/op/lex_assign.t		See if ops involving lexicals or pad temps work
 t/op/lex.t			Tests too complex for t/base/lex.t
diff -Nup blead/gv.c blead-76138-clobbered-SIG/gv.c
--- blead/gv.c	2010-07-24 08:14:09.000000000 -0700
+++ blead-76138-clobbered-SIG/gv.c	2010-08-10 09:31:27.000000000 -0700
@@ -1204,33 +1204,19 @@ Perl_gv_fetchpvn_flags(pTHX_ const char 
         GvMULTI_on(gv) ;
 
     /* set up magic where warranted */
-    if (len > 1) {
-#ifndef EBCDIC
-	if (*name > 'V' ) {
-	    NOOP;
-	    /* Nothing else to do.
-	       The compiler will probably turn the switch statement into a
-	       branch table. Make sure we avoid even that small overhead for
-	       the common case of lower case variable names.  */
-	} else
-#endif
-	{
+    if (stash != PL_defstash) { /* not the main stash */
+	/* We only have to check for four names here: EXPORT, ISA, OVERLOAD
+	   and VERSION. All the others apply only to the main stash. */
+	if (len > 1) {
 	    const char * const name2 = name + 1;
 	    switch (*name) {
-	    case 'A':
-		if (strEQ(name2, "RGV")) {
-		    IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
-		}
-		else if (strEQ(name2, "RGVOUT")) {
-		    GvMULTI_on(gv);
-		}
-		break;
 	    case 'E':
 		if (strnEQ(name2, "XPORT", 5))
 		    GvMULTI_on(gv);
 		break;
 	    case 'I':
-		if (strEQ(name2, "SA")) {
+		if (strEQ(name2, "SA"))
+		magicalise_isa: {
 		    AV* const av = GvAVn(gv);
 		    GvMULTI_on(gv);
 		    sv_magic(MUTABLE_SV(av), MUTABLE_SV(gv), PERL_MAGIC_isa,
@@ -1253,12 +1239,49 @@ Perl_gv_fetchpvn_flags(pTHX_ const char 
 		}
 		break;
 	    case 'O':
-		if (strEQ(name2, "VERLOAD")) {
+		if (strEQ(name2, "VERLOAD"))
+		magicalise_overload: {
 		    HV* const hv = GvHVn(gv);
 		    GvMULTI_on(gv);
 		    hv_magic(hv, NULL, PERL_MAGIC_overload);
 		}
 		break;
+	    case 'V':
+		if (strEQ(name2, "ERSION"))
+		    GvMULTI_on(gv);
+		break;
+	    }
+	}
+    }
+    else if (len > 1) {
+#ifndef EBCDIC
+	if (*name > 'V' ) {
+	    NOOP;
+	    /* Nothing else to do.
+	       The compiler will probably turn the switch statement into a
+	       branch table. Make sure we avoid even that small overhead for
+	       the common case of lower case variable names.  */
+	} else
+#endif
+	{
+	    const char * const name2 = name + 1;
+	    switch (*name) {
+	    case 'A':
+		if (strEQ(name2, "RGV")) {
+		    IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
+		}
+		else if (strEQ(name2, "RGVOUT")) {
+		    GvMULTI_on(gv);
+		}
+		break;
+	    case 'E':
+		if (strnEQ(name2, "XPORT", 5))
+		    GvMULTI_on(gv);
+		break;
+	    case 'I':
+		goto magicalise_isa;
+	    case 'O':
+		goto magicalise_overload;
 	    case 'S':
 		if (strEQ(name2, "IG")) {
 		    HV *hv;
diff -Nurp blead/t/op/leaky-magic.t blead-76138-clobbered-SIG/t/op/leaky-magic.t
--- blead/t/op/leaky-magic.t	1969-12-31 16:00:00.000000000 -0800
+++ blead-76138-clobbered-SIG/t/op/leaky-magic.t	2010-08-10 06:25:21.000000000 -0700
@@ -0,0 +1,128 @@
+#!./perl
+
+# This script checks that magic attached to global variables ($!, %SIG,
+# etc.) only applies to the globals, and not to similarly-named variables
+# in other packages (%Net::DNS::RR::SIG, ${"'Oh no'!"}, etc.).
+
+BEGIN {
+    chdir 't' if -d 't';
+    require './test.pl';
+    @INC = '../lib';
+}
+
+# Hack to allow test counts to be specified piecemeal
+BEGIN { ++$INC{'tests.pm'} }
+sub tests'VERSION { $tests += pop };
+plan (tests => $tests);
+
+
+use tests 2; # First make sure that %! %- %+ do not load extra modules.
+map %{"foo::$_"}, qw< ! - + >;
+ok !exists $INC{'Errno.pm'}, '$swext::! does not load Errno';
+ok !exists $INC{'Tie/Hash/NamedCapture.pm'},
+  '$foo::+ and $foo::- do not load Tie::Hash::NamedCapture';
+
+use tests 1; # ARGV
+fresh_perl_is
+ '$count=0; ++$count while(<foo::ARGV>); print $count',
+ '0',
+  { stdin => 'swext\n' },
+ '<foo::ARGV> does not iterate through STDIN';
+
+use tests 1; # %SIG
+ok !scalar keys %foo::SIG, "%foo::SIG";
+
+use tests 4; # rw ${^LETTERS} variables
+for(qw< CHILD_ERROR_NATIVE ENCODING UTF8CACHE WARNING_BITS >) {
+ my $name = s/./"qq|\\c$&|"/ere;
+ local $$name = 'swit';
+
+ # Bring it into existence first, as defined() sometimes takes shortcuts
+ ${"foo::$name"};
+
+ ok !defined(${"foo::$name"}), "\$foo::^$_";
+}
+
+use tests 6; # read-only ${^LETTERS}
+for(qw< MATCH PREMATCH POSTMATCH TAINT UNICODE UTF8LOCALE >) {
+ ok eval { ${"foo::" . s/./"qq|\\c$&|"/ere} = 'prile' }, "\$foo::^$_";
+}
+
+use tests 16; # $<digits> and $<single digit> (regexp only, not $0)
+for(qw< 1 2 3 4 5 6 7 8 9 324897 237 635 6780 42 14 >) {
+ ok eval { ${"foo::$_"} = 'prile' }, "\$foo::$_";
+}
+
+use tests 5; # read-only single-char scalars
+for(qw< & ` ' + ] >) {
+ ok eval { ${"foo::$_"} = 'twor'}, "\$foo::$_";
+}
+
+use tests 14; # rw single-char scalars we can safely modify
+{
+ # $. doesn�t appear magical from Perl-space until a filehandle has been
+ # read, so we�ll do that right now.
+ open my $fh, "<", \"freen";
+ <$fh>;
+
+ for(qw< : ? ! - | ^ ~ = % . \ / ; 0 >) {
+  local $$_ = 'thew';
+  ${"foo::$_"}; # touch it
+  ok !defined ${"foo::$_"}, "\$foo::$_";
+ }
+}
+
+use tests 1; # %!
+ok scalar keys %{"foo::!"} == 0, '%foo::!';
+
+use tests 4; # [@%][+-]
+ok eval { ${"foo::+"}{strat} = 'quin' }, '%foo::+';
+ok eval { ${"foo::-"}{strat} = 'quin' }, '%foo::-';
+ok eval { ${"foo::+"}[47]    = 'quin' }, '@foo::+';
+ok eval { ${"foo::-"}[63]    = 'quin' }, '@foo::-';
+
+use tests 1; # $# - This naughty little thing just warns.
+{
+ my $w = '';
+ local $SIG{__WARN__} = sub { $w = shift };
+ eval '${"foo::#"}';
+ is $w, '', '$foo::#';
+}
+
+use tests 11; # rw $^X scalars
+for(qw<  C O I L   H A D   W E P T  >) {
+ my $name = eval "qq|\\c$_|";
+ local $$name = 'zow';
+ ${"foo::$name"}; # touch
+ ok !defined ${"foo::$name"}, "\$foo::^$_";
+}
+
+use tests 1; # read-only $^X scalars
+for(qw< S V >) {
+ my $name = eval "qq|\\c$_|";
+ ok eval { ${"foo::$name"} = 'twor'}, "\$foo::^$_";
+}
+
+use tests 1; # $[
+# To avoid tests that are *too* weird, we�ll just check for definition.
+${"foo::["}; # touch
+ok !defined ${"foo::["}, '$foo::[';
+
+use tests 4; # user/group vars
+# These are rw, but setting them is obviously going to make the test much
+# more complex than necessary. So, again, we check for definition.
+for(qw<   < > ( )   >) {
+ ${"foo::$_"}; # touch
+ ok !defined ${"foo::$_"}, "\$foo::$_";
+}
+
+use tests 1; # $^N
+# This is a cheeky little blighter. It�s not read-only, but setting it does
+# nothing. It is undefined by default.
+{
+  my $thing;
+ "felp" =~ /(.)(?{ $thing = ${"foo::\cN"} })/;
+  ok !defined $thing, '$foo::^N';
+}
+
+# I think that�s it!

[p5pRT]

From @cpansprout

To be copied and pasted into the appropriate sections.

---

Incompatible changes

---

=head2 Magic Variables Outside the Main Package

In previous versions of perl, magic variables like C<$!>, C<%SIG>, etc.
would 'leak' into other packages. So C<%foo​::SIG> could be used to access
signals, C<${"foo​::!"}> (with strict mode off) to access C's C<errno>, etc.

This was a bug, or an 'unintentional' feature, which caused various ill
effects, such as signal handlers being wiped when modules were loaded, etc.

This has been fixed (or the feature has been removed, depending on how you
see it).

---

Testing

---

=item *

The new F<t/op/leaky-magic.t> script tests that magic applied to variables
in the main packages does not affect other packages.

---

Selected Bug Fixes

---

=item *

Magic applied to variables in the main package no longer affects other
packages. See L</Magic Variables Outside the Main Package>, above
[perl #76138].

[p5pRT]

From @cpansprout

On Aug 15, 2010, at 1​:30 PM, Father Chrysostomos wrote​:

On Aug 9, 2010, at 11​:13 AM, Jesse Vincent wrote​:

but if we're going to do it, it would make sense to try
it earlier (nowish) in the blead cycle and step it back than to wait
until the last minute.

Here�s a patch.

Is there any chance someone could review this patch? It would be nice if it could be applied before Jesse decides it�s too late.

[p5pRT]

From @avar

On Mon, Aug 30, 2010 at 15​:54, Father Chrysostomos <sprout@​cpan.org> wrote​:

On Aug 15, 2010, at 1​:30 PM, Father Chrysostomos wrote​:

On Aug 9, 2010, at 11​:13 AM, Jesse Vincent wrote​:

but if we're going to do it, it would make sense to try
it earlier (nowish) in the blead cycle and step it back than to wait
until the last minute.

Here�s a patch.

Is there any chance someone could review this patch? It would be nice if it could be applied before Jesse decides it�s too late.

It would be a lot easier to review and apply if you made it with Git
and git-format-patch instead of attaching a diff and something to be
manually copy/pasted to the perldelta.

[p5pRT]

From @rafl

Father Chrysostomos <sprout@​cpan.org> writes​:

Here�s a patch. All tests pass, except for cpan/CGI/t/http.t, which
always fails. Attached also is a file with perldelta entries.

Thank you! I very much appreciate you writing perldelta entries for your
changes.

The diff may be a bit confusing. I moved the cases for ISA and
OVERLOAD up into a new switch block that only applies to packages
other than main. diff found a different way of looking at it.

This part of the diff has me a little confused​:

+ case 'I'​:
+ goto magicalise_isa;
+ case 'O'​:
+ goto magicalise_overload;
  case 'S'​:
  if (strEQ(name2, "IG")) {
  HV *hv;

That's a chunk in the second switch, for symbols in PL_defstash. Why
does ISA and OVERLOAD need special handling there? And they do, why is
it enough to check only for the first character before jumping to the
relevant code in tie first switch for symbols in main​::?

Without those 4 lines, all the tests still pass.

For posterity, every test in leaky-magic.t fails without the gv.c
changes, except for qw< %! %+ %- $/ $​: $0 >, which seem to be
unaffected by this bug.

In that test, you do

+sub tests'VERSION { $tests += pop };

Is using ' instead of :​: there actually relevant to the test? It seems
like there's a pretty broad consensus on not doing that anymore for new
code within the core.

[p5pRT]

From @cpansprout

On Aug 31, 2010, at 10​:24 AM, Florian Ragwitz wrote​:

Father Chrysostomos <sprout@​cpan.org> writes​:

Here�s a patch. All tests pass, except for cpan/CGI/t/http.t, which
always fails. Attached also is a file with perldelta entries.

Thank you! I very much appreciate you writing perldelta entries for your
changes.

The diff may be a bit confusing. I moved the cases for ISA and
OVERLOAD up into a new switch block that only applies to packages
other than main. diff found a different way of looking at it.

This part of the diff has me a little confused​:

+ case 'I'​:
+ goto magicalise_isa;
+ case 'O'​:
+ goto magicalise_overload;
case 'S'​:
if (strEQ(name2, "IG")) {
HV *hv;

That's a chunk in the second switch, for symbols in PL_defstash. Why
does ISA and OVERLOAD need special handling there?

Because main is a package just like any other, except that it�s not like any other.

And they do, why is
it enough to check only for the first character before jumping to the
relevant code in tie first switch for symbols in main​::?

That was a mistake. Thank you for catching it!

Without those 4 lines, all the tests still pass.

Thatâ��s because there are not enough tests. Iâ��ve attached a test for @​main​::ISA. I managed to get â��use overloadâ�� from main to produce warnings, but I canâ��t reproduce it in a test script without fresh_perl. Is there any reason we couldnâ��t switch lib/overload.t over to test.pl?

$ ./perl -Ilib -lwe 'use overload q\""\ => sub {"ning"}; print bless []'
Name "main​::OVERLOAD" used only once​: possible typo at lib/overload.pm line 11.
ning

For posterity, every test in leaky-magic.t fails without the gv.c
changes, except for qw< %! %+ %- $/ $​: $0 >, which seem to be
unaffected by this bug.

In that test, you do

+sub tests'VERSION { $tests += pop };

Is using ' instead of :​: there actually relevant to the test? It seems
like there's a pretty broad consensus on not doing that anymore for new
code within the core.

OK, I�ve changed it. That was copied and pasted from elsewhere. But doesn�t it make it less likely that we�ll catch buggy interactions between features if we try to keep the tests too standardised?

Attached is a new patch.

[p5pRT]

From @cpansprout

From​: Father Chrysostomos <sprout@​cpan.org>

[perl #76138] perl inadvertently destroys signal handlers as of f746176

Stop magic applied to $!, %SIG, et al. from applying to similarly-
named variables in other packages.

Inline Patch

diff -up blead-76138-clobbered-SIG0/MANIFEST blead-76138-clobbered-SIG1/MANIFEST
--- blead-76138-clobbered-SIG0/MANIFEST	2010-08-24 11:23:13.000000000 -0700
+++ blead-76138-clobbered-SIG1/MANIFEST	2010-09-02 08:28:00.000000000 -0700
@@ -4525,6 +4525,7 @@ t/op/join.t			See if join works
 t/op/kill0.t			See if kill(0, $pid) works
 t/op/lc.t			See if lc, uc, lcfirst, ucfirst, quotemeta work
 t/op/lc_user.t			See if user-defined lc et alia work
+t/op/leaky-magic.t		See whether vars' magic leaks into packages
 t/op/length.t			See if length works
 t/op/lex_assign.t		See if ops involving lexicals or pad temps work
 t/op/lex.t			Tests too complex for t/base/lex.t
diff -up blead-76138-clobbered-SIG0/gv.c blead-76138-clobbered-SIG1/gv.c
--- blead-76138-clobbered-SIG0/gv.c	2010-07-24 08:14:09.000000000 -0700
+++ blead-76138-clobbered-SIG1/gv.c	2010-09-02 20:23:52.000000000 -0700
@@ -1204,33 +1204,19 @@ Perl_gv_fetchpvn_flags(pTHX_ const char 
         GvMULTI_on(gv) ;
 
     /* set up magic where warranted */
-    if (len > 1) {
-#ifndef EBCDIC
-	if (*name > 'V' ) {
-	    NOOP;
-	    /* Nothing else to do.
-	       The compiler will probably turn the switch statement into a
-	       branch table. Make sure we avoid even that small overhead for
-	       the common case of lower case variable names.  */
-	} else
-#endif
-	{
+    if (stash != PL_defstash) { /* not the main stash */
+	/* We only have to check for four names here: EXPORT, ISA, OVERLOAD
+	   and VERSION. All the others apply only to the main stash. */
+	if (len > 1) {
 	    const char * const name2 = name + 1;
 	    switch (*name) {
-	    case 'A':
-		if (strEQ(name2, "RGV")) {
-		    IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
-		}
-		else if (strEQ(name2, "RGVOUT")) {
-		    GvMULTI_on(gv);
-		}
-		break;
 	    case 'E':
 		if (strnEQ(name2, "XPORT", 5))
 		    GvMULTI_on(gv);
 		break;
 	    case 'I':
-		if (strEQ(name2, "SA")) {
+		if (strEQ(name2, "SA"))
+		magicalise_isa: {
 		    AV* const av = GvAVn(gv);
 		    GvMULTI_on(gv);
 		    sv_magic(MUTABLE_SV(av), MUTABLE_SV(gv), PERL_MAGIC_isa,
@@ -1253,12 +1239,55 @@ Perl_gv_fetchpvn_flags(pTHX_ const char 
 		}
 		break;
 	    case 'O':
-		if (strEQ(name2, "VERLOAD")) {
+		if (strEQ(name2, "VERLOAD"))
+		magicalise_overload: {
 		    HV* const hv = GvHVn(gv);
 		    GvMULTI_on(gv);
 		    hv_magic(hv, NULL, PERL_MAGIC_overload);
 		}
 		break;
+	    case 'V':
+		if (strEQ(name2, "ERSION"))
+		    GvMULTI_on(gv);
+		break;
+	    }
+	}
+    }
+    else if (len > 1) {
+#ifndef EBCDIC
+	if (*name > 'V' ) {
+	    NOOP;
+	    /* Nothing else to do.
+	       The compiler will probably turn the switch statement into a
+	       branch table. Make sure we avoid even that small overhead for
+	       the common case of lower case variable names.  */
+	} else
+#endif
+	{
+	    const char * const name2 = name + 1;
+	    switch (*name) {
+	    case 'A':
+		if (strEQ(name2, "RGV")) {
+		    IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
+		}
+		else if (strEQ(name2, "RGVOUT")) {
+		    GvMULTI_on(gv);
+		}
+		break;
+	    case 'E':
+		if (strnEQ(name2, "XPORT", 5))
+		    GvMULTI_on(gv);
+		break;
+	    case 'I':
+		if (strEQ(name2, "SA")) {
+		    goto magicalise_isa;
+		}
+		break;
+	    case 'O':
+		if (strEQ(name2, "VERLOAD")) {
+		    goto magicalise_overload;
+		}
+		break;
 	    case 'S':
 		if (strEQ(name2, "IG")) {
 		    HV *hv;
diff -Nurp blead-76138-clobbered-SIG0/t/op/leaky-magic.t blead-76138-clobbered-SIG1/t/op/leaky-magic.t
--- blead-76138-clobbered-SIG0/t/op/leaky-magic.t	1969-12-31 16:00:00.000000000 -0800
+++ blead-76138-clobbered-SIG1/t/op/leaky-magic.t	2010-09-02 20:21:18.000000000 -0700
@@ -0,0 +1,128 @@
+#!./perl
+
+# This script checks that magic attached to global variables ($!, %SIG,
+# etc.) only applies to the globals, and not to similarly-named variables
+# in other packages (%Net::DNS::RR::SIG, ${"'Oh no'!"}, etc.).
+
+BEGIN {
+    chdir 't' if -d 't';
+    require './test.pl';
+    @INC = '../lib';
+}
+
+# Hack to allow test counts to be specified piecemeal
+BEGIN { ++$INC{'tests.pm'} }
+sub tests::VERSION { $tests += pop };
+plan (tests => $tests);
+
+
+use tests 2; # First make sure that %! %- %+ do not load extra modules.
+map %{"foo::$_"}, qw< ! - + >;
+ok !exists $INC{'Errno.pm'}, '$swext::! does not load Errno';
+ok !exists $INC{'Tie/Hash/NamedCapture.pm'},
+  '$foo::+ and $foo::- do not load Tie::Hash::NamedCapture';
+
+use tests 1; # ARGV
+fresh_perl_is
+ '$count=0; ++$count while(<foo::ARGV>); print $count',
+ '0',
+  { stdin => 'swext\n' },
+ '<foo::ARGV> does not iterate through STDIN';
+
+use tests 1; # %SIG
+ok !scalar keys %foo::SIG, "%foo::SIG";
+
+use tests 4; # rw ${^LETTERS} variables
+for(qw< CHILD_ERROR_NATIVE ENCODING UTF8CACHE WARNING_BITS >) {
+ my $name = s/./"qq|\\c$&|"/ere;
+ local $$name = 'swit';
+
+ # Bring it into existence first, as defined() sometimes takes shortcuts
+ ${"foo::$name"};
+
+ ok !defined(${"foo::$name"}), "\$foo::^$_";
+}
+
+use tests 6; # read-only ${^LETTERS}
+for(qw< MATCH PREMATCH POSTMATCH TAINT UNICODE UTF8LOCALE >) {
+ ok eval { ${"foo::" . s/./"qq|\\c$&|"/ere} = 'prile' }, "\$foo::^$_";
+}
+
+use tests 16; # $<digits> and $<single digit> (regexp only, not $0)
+for(qw< 1 2 3 4 5 6 7 8 9 324897 237 635 6780 42 14 >) {
+ ok eval { ${"foo::$_"} = 'prile' }, "\$foo::$_";
+}
+
+use tests 5; # read-only single-char scalars
+for(qw< & ` ' + ] >) {
+ ok eval { ${"foo::$_"} = 'twor'}, "\$foo::$_";
+}
+
+use tests 14; # rw single-char scalars we can safely modify
+{
+ # $. doesn�t appear magical from Perl-space until a filehandle has been
+ # read, so we�ll do that right now.
+ open my $fh, "<", \"freen";
+ <$fh>;
+
+ for(qw< : ? ! - | ^ ~ = % . \ / ; 0 >) {
+  local $$_ = 'thew';
+  ${"foo::$_"}; # touch it
+  ok !defined ${"foo::$_"}, "\$foo::$_";
+ }
+}
+
+use tests 1; # %!
+ok scalar keys %{"foo::!"} == 0, '%foo::!';
+
+use tests 4; # [@%][+-]
+ok eval { ${"foo::+"}{strat} = 'quin' }, '%foo::+';
+ok eval { ${"foo::-"}{strat} = 'quin' }, '%foo::-';
+ok eval { ${"foo::+"}[47]    = 'quin' }, '@foo::+';
+ok eval { ${"foo::-"}[63]    = 'quin' }, '@foo::-';
+
+use tests 1; # $# - This naughty little thing just warns.
+{
+ my $w = '';
+ local $SIG{__WARN__} = sub { $w = shift };
+ eval '${"foo::#"}';
+ is $w, '', '$foo::#';
+}
+
+use tests 11; # rw $^X scalars
+for(qw<  C O I L   H A D   W E P T  >) {
+ my $name = eval "qq|\\c$_|";
+ local $$name = 'zow';
+ ${"foo::$name"}; # touch
+ ok !defined ${"foo::$name"}, "\$foo::^$_";
+}
+
+use tests 1; # read-only $^X scalars
+for(qw< S V >) {
+ my $name = eval "qq|\\c$_|";
+ ok eval { ${"foo::$name"} = 'twor'}, "\$foo::^$_";
+}
+
+use tests 1; # $[
+# To avoid tests that are *too* weird, we�ll just check for definition.
+${"foo::["}; # touch
+ok !defined ${"foo::["}, '$foo::[';
+
+use tests 4; # user/group vars
+# These are rw, but setting them is obviously going to make the test much
+# more complex than necessary. So, again, we check for definition.
+for(qw<   < > ( )   >) {
+ ${"foo::$_"}; # touch
+ ok !defined ${"foo::$_"}, "\$foo::$_";
+}
+
+use tests 1; # $^N
+# This is a cheeky little blighter. It�s not read-only, but setting it does
+# nothing. It is undefined by default.
+{
+  my $thing;
+ "felp" =~ /(.)(?{ $thing = ${"foo::\cN"} })/;
+  ok !defined $thing, '$foo::^N';
+}
+
+# I think that�s it!

[p5pRT]

From @cpansprout

Inline Patch

diff -rup blead-76138-clobbered-SIG0/t/mro/basic.t blead-76138-clobbered-SIG1/t/mro/basic.t
--- blead-76138-clobbered-SIG0/t/mro/basic.t	2010-02-18 09:13:09.000000000 -0800
+++ blead-76138-clobbered-SIG1/t/mro/basic.t	2010-09-02 17:56:19.000000000 -0700
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-require q(./test.pl); plan(tests => 48);
+BEGIN { require q(./test.pl); } plan(tests => 49);
 
 require mro;
 
@@ -287,3 +287,16 @@ is(eval { MRO_N->testfunc() }, 123);
     };
     is($@, "");
 }
+
+{
+    # @main::ISA
+    no warnings 'once';
+    @main::ISA = 'parent';
+    my $output = '';
+    *parent::do = sub { $output .= 'parent' };
+    *parent2::do = sub { $output .= 'parent2' };
+    main->do;
+    @main::ISA = 'parent2';
+    main->do;
+    is $output, 'parentparent2', '@main::ISA is magical';
+}