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
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"))
+ magicalize_isa: {
AV* const av = GvAVn(gv);
GvMULTI_on(gv);
sv_magic(MUTABLE_SV(av), MUTABLE_SV(gv), PERL_MAGIC_isa,
}
break;
case 'O':
- if (strEQ(name2, "VERLOAD")) {
+ if (strEQ(name2, "VERLOAD"))
+ magicalize_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 magicalize_isa;
+ }
+ break;
+ case 'O':
+ if (strEQ(name2, "VERLOAD")) {
+ goto magicalize_overload;
+ }
+ break;
case 'S':
if (strEQ(name2, "IG")) {
HV *hv;
=head1 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).
+
=head2 C API changes
The first argument of the C API function C<Perl_fetch_cop_label> has changed
A rare race condition in F<t/op/while_readdir.t> has been fixed, stopping it
from failing randomly when running tests in parallel.
+=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.
+
=back
=head1 Platform Support
A possible string corruption when doing regular expression matches on overloaded
objects has been fixed (RT#77084).
+=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].
+
=back
=head1 Known Problems
use strict;
use warnings;
-require q(./test.pl); plan(tests => 48);
+BEGIN { require q(./test.pl); } plan(tests => 49);
require mro;
};
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';
+}
--- /dev/null
+#!./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 = 'poof'; # we're setting, among other things, $^D, so all
+ # characters in here must be valid -D flags
+ ${"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!
https://perl5.git.perl.org / perl5.git / commitdiff