perl -wle '%::=();//' crash #9326
Comments
From @rurbanperl -wle '%::=();//' crashes in all perl versions. In regexec.c PL_replgv is empty after the whole symboltable is cleared regexec.c: SV* const oreplsv = GvSV(PL_replgv); I would check for the empty gp pointer in PL_replgv and create an empty -- |
From @rurbanJust for reference: But I haven't decided yet how to fix #54044. |
From [Unknown Contact. See original ticket]Just for reference: But I haven't decided yet how to fix #54044. |
|
@rurban - Status changed from 'new' to 'open' |
From jettero@cpan.orgThis is a bug report for perl from jettero@cpan.org, I think it's a little silly to report, but I was encouraged to do so. %::();// # <-- seems to crash the system I'm not really the person that figured that out. It seems to be -paul Flags: Site configuration information for perl v5.8.8: Configured by Debian Project at Tue Dec 4 09:07:29 UTC 2007. Summary of my perl5 (revision 5 version 8 subversion 8) configuration: Locally applied patches: @INC for perl v5.8.8: Environment for perl v5.8.8: |
From @AbigailOn Mon, May 12, 2008 at 07:57:55PM +0200, Reini Urban wrote:
In 5.10.0, I get: $ perl -wle '%::=();//' Anything else gives me a segmentation fault. Abigail |
From @smpetersOn Mon, May 12, 2008 at 2:30 PM, via RT jettero @ cpan. org
Actually, thanks for reporting the segfault. You should actually To your problem, though, I cannot even get the code above to parse. Steve Peters |
From @demerphq2008/5/16 Steve Peters <steve@fisharerojo.org>:
At one point someone was randomly generating code snippets and was Yves -- |
From @nwc10On Fri, May 16, 2008 at 10:23:43PM +0200, demerphq wrote:
Such as revisiting this? http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-05/msg01959.html Nicholas Clark |
From @demerphq2008/5/16 Nicholas Clark <nick@ccl4.org>:
Yep. Thats the one. Wow. Quick on the draw aintchya. :-) cheers, -- |
From p5p@perl.wizbit.beQuoting Steve Peters <steve@fisharerojo.org>:
That's because the example is wrong. It should be: %::=();//; It got reported as: [perl #54044] perl -wle '%::=();//' crash [perl #54050] Segmentation Fault from ordinary, if unusual, perl code Kind regards, Bram |
From @rurbanjettero@cpan.org (via RT) schrieb:
That's a simple copy&paste error and a duplicate from Please close this.
-- |
From @HugmeirCreated by fraserb@gmail.comperl -e 'undef %::; chdir' undef %::; makes several functions[*] that use global variables I haven't bisected it, but it starts crashing somewhere between This can be solved in a case by case basis by checking that * both evals, chdir, require, sort, .., stat, glob, print/say, warn, Perl Info |
From @HugmeirOn Thu, Mar 28, 2013 at 5:34 PM, Brian Fraser <perlbug-followup@perl.org> wrote:
Actually, faulty test case. I was testing with 'perl -E "undef %::"', |
From @HugmeirOn Thu, Mar 28, 2013 at 5:42 PM, Brian Fraser <fraserbn@gmail.com> wrote:
Attached file is just a handful of test cases for this. |
From @Hugmeir0001-Test-cases-for-117393.patchFrom 2727b2614f0d89cc8cf837c32915f521b3a05865 Mon Sep 17 00:00:00 2001
From: Brian Fraser <fraserbn@gmail.com>
Date: Thu, 28 Mar 2013 18:37:38 -0300
Subject: [PATCH] Test cases for 117393
---
t/op/undef.t | 13 ++++++++++++-
1 file changed, 12 insertions(+), 1 deletion(-)
diff --git a/t/op/undef.t b/t/op/undef.t
index eafa6db..bfdb500 100644
--- a/t/op/undef.t
+++ b/t/op/undef.t
@@ -10,7 +10,7 @@ use strict;
use vars qw(@ary %ary %hash);
-plan 85;
+plan 89;
ok !defined($a);
@@ -176,3 +176,14 @@ sub PVBM () { 'foo' }
my $pvbm = PVBM;
undef $pvbm;
ok !defined $pvbm;
+
+TODO: {
+ local $::TODO = '# [117393], undef %::; causes several crashes';
+ for my $op ( qw[ eval chdir() glob() require(strict) ] ) {
+ fresh_perl_like(
+ "my \$stdout = \\*STDOUT; undef \%::; $op; print { \$stdout } q{$op survived\n}",
+ qr/$op survived/,
+ "[117393] undef \%::; $op; doesn't crash"
+ );
+ }
+}
\ No newline at end of file
--
1.7.10.4
|
From @HugmeirOn Thu, Mar 28, 2013 at 5:34 PM, Brian Fraser <perlbug-followup@perl.org> wrote:
Pardons for the barrage of mails. Here's a related case, and how I But this does not: This is because there's a call to gv_fetchpvs in toke.c that adds the That call has been there, some modifications in-between |
From @wolfsageHmm, is this https://rt-archive.perl.org/perl5/Ticket/Display.html?id=54044 again? -- Matthew Horsfall (alh) |
|
The RT System itself - Status changed from 'new' to 'open' |
From @HugmeirOn Thu, Apr 4, 2013 at 7:07 PM, Matthew Horsfall via RT <
Looks like it, I think this ticket can be merged. |
From @rurbanThis is a bug report for perl from rurban@cpanel.net, From 40bb0e6fc1252879ea0cd48a0267e4db5a2d6bc7 Mon Sep 17 00:00:00 2001 This is a multi-part message in MIME format. Perl used to crash when the %main:: stash is undef'ed or cleared and some hv.c | 4 ++++ --------------1.7.10.4 Inline Patchdiff --git a/hv.c b/hv.c
index ec1bfe8..4e93315 100644
--- a/hv.c
+++ b/hv.c
@@ -1469,6 +1469,8 @@ Perl_hv_clear(pTHX_ HV *hv)
xhv = (XPVHV*)SvANY(hv);
ENTER;
+ if ( hv == PL_defstash && PL_phase != PERL_PHASE_DESTRUCT )
+ croak("Attempt to clear the %main:: symbol table");
SAVEFREESV(SvREFCNT_inc_simple_NN(hv));
if (SvREADONLY(hv) && HvARRAY(hv) != NULL) {
/* restricted hash: convert all keys to placeholders */
@@ -1706,6 +1708,8 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
/* note that the code following prior to hfreeentries is duplicated
* in sv_clear(), and changes here should be done there too */
if (PL_phase != PERL_PHASE_DESTRUCT && (name = HvNAME(hv))) {
+ if (hv == PL_defstash)
+ croak("Attempt to clear the %main:: symbol table");
if (PL_stashcache) {
DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for '%"
HEKf"'\n", HvNAME_HEK(hv)));
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index f7eb662..f3fb28b 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -277,6 +277,15 @@ example by:
bless $self, "$proto";
+=item Attempt to clear the %main:: symbol table
+
+(F) The failing code attempted to delete or set the C<%main::>
+symboltable, with something like C<%::=()> or C<undef %::>. If you
+want to really clear all entries from the C<%main::> symboltable you
+need to do it manually, element by element. But beware that a lot of
+magic main symbols entries are required, e.g. for the regex engine,
+and all namespaces will be gone also, as they are keys of C<%main::>.
+
=item Attempt to clear deleted array
(S debugging) An array was assigned to when it was being freed.
diff --git a/sv.c b/sv.c
index 3736ba8..b095591 100644
--- a/sv.c
+++ b/sv.c
@@ -6120,6 +6120,8 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
/* Free back-references before magic, in case the magic calls
* Perl code that has weak references to sv. */
if (type == SVt_PVHV) {
+ if (PL_phase != PERL_PHASE_DESTRUCT && hv == PL_defstash)
+ croak("Attempt to clear the %main:: symbol table");
Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv));
if (SvMAGIC(sv))
mg_free(sv);
diff --git a/t/op/stash.t b/t/op/stash.t
index fd5450e..fd9392c 100644
--- a/t/op/stash.t
+++ b/t/op/stash.t
@@ -7,12 +7,12 @@ BEGIN {
BEGIN { require "./test.pl"; }
-plan( tests => 58 );
+plan( tests => 59 );
-# Used to segfault (bug #15479)
+# Used to segfault (bug #15479 and #54044)
fresh_perl_like(
'%:: = ""',
- qr/Odd number of elements in hash assignment at - line 1\./,
+ qr/^Attempt to clear the %main:: symbol table at - line 1\./,
{ switches => [ '-w' ] },
'delete $::{STDERR} and print a warning',
);
@@ -60,7 +60,7 @@ package main;
local $ENV{PERL_DESTRUCT_LEVEL} = 2;
fresh_perl_is(
'package A; sub a { // }; %::=""',
- '',
+ 'Attempt to clear the current symbol table at - line 1.',
'',
);
# Variant of the above which creates an object that persists until global
@@ -336,3 +336,11 @@ ok eval '
sub foo{};
1
', 'no crashing or errors when clobbering the current package';
+
+{
+ # [perl #54004] disallow setting i.e. clearing %main::
+ eval '%::=()';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval '%main:: = ($_ = "")';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+}
diff --git a/t/op/undef.t b/t/op/undef.t
index eafa6db..fa4cdfc 100644
--- a/t/op/undef.t
+++ b/t/op/undef.t
@@ -10,7 +10,7 @@ use strict;
use vars qw(@ary %ary %hash);
-plan 85;
+plan 90;
ok !defined($a);
@@ -176,3 +176,17 @@ sub PVBM () { 'foo' }
my $pvbm = PVBM;
undef $pvbm;
ok !defined $pvbm;
+
+{
+ # [perl #54004] disallow undef %main::
+ eval 'undef %::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval 'undef %main::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval 'undef %main::main::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval 'package A; undef %main::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval 'package A; undef %::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+}
--------------1.7.10.4--
---
This perlbug was built using Perl 5.17.3 - Mon Jul 30 16:28:27 CDT 2012 Site configuration information for perl 5.14.2: Configured by rurban at Wed Oct 26 17:33:43 CDT 2011. Summary of my perl5 (revision 5 version 14 subversion 2) configuration: Locally applied patches: @INC for perl 5.14.2: Environment for perl 5.14.2: |
From @rurban---------- Forwarded message ---------- This is a bug report for perl from rurban@cpanel.net, From 40bb0e6fc1252879ea0cd48a0267e4db5a2d6bc7 Mon Sep 17 00:00:00 2001 This is a multi-part message in MIME format. Perl used to crash when the %main:: stash is undef'ed or cleared and some hv.c | 4 ++++ --------------1.7.10.4 Inline Patchdiff --git a/hv.c b/hv.c
index ec1bfe8..4e93315 100644
--- a/hv.c
+++ b/hv.c
@@ -1469,6 +1469,8 @@ Perl_hv_clear(pTHX_ HV *hv)
xhv = (XPVHV*)SvANY(hv);
ENTER;
+ if ( hv == PL_defstash && PL_phase != PERL_PHASE_DESTRUCT )
+ croak("Attempt to clear the %main:: symbol table");
SAVEFREESV(SvREFCNT_inc_simple_NN(hv));
if (SvREADONLY(hv) && HvARRAY(hv) != NULL) {
/* restricted hash: convert all keys to placeholders */
@@ -1706,6 +1708,8 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
/* note that the code following prior to hfreeentries is duplicated
* in sv_clear(), and changes here should be done there too */
if (PL_phase != PERL_PHASE_DESTRUCT && (name = HvNAME(hv))) {
+ if (hv == PL_defstash)
+ croak("Attempt to clear the %main:: symbol table");
if (PL_stashcache) {
DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing
Inline Patchdiff --git a/pod/perldiag.pod b/pod/perldiag.pod
index f7eb662..f3fb28b 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -277,6 +277,15 @@ example by:
bless $self, "$proto";
+=item Attempt to clear the %main:: symbol table
+
+(F) The failing code attempted to delete or set the C<%main::>
+symboltable, with something like C<%::=()> or C<undef %::>. If you
+want to really clear all entries from the C<%main::> symboltable you
+need to do it manually, element by element. But beware that a lot of
+magic main symbols entries are required, e.g. for the regex engine,
+and all namespaces will be gone also, as they are keys of C<%main::>.
+
=item Attempt to clear deleted array
(S debugging) An array was assigned to when it was being freed.
diff --git a/sv.c b/sv.c
index 3736ba8..b095591 100644
--- a/sv.c
+++ b/sv.c
@@ -6120,6 +6120,8 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
/* Free back-references before magic, in case the magic calls
* Perl code that has weak references to sv. */
if (type == SVt_PVHV) {
+ if (PL_phase != PERL_PHASE_DESTRUCT && hv == PL_defstash)
+ croak("Attempt to clear the %main:: symbol table");
Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv));
if (SvMAGIC(sv))
mg_free(sv);
diff --git a/t/op/stash.t b/t/op/stash.t
index fd5450e..fd9392c 100644
--- a/t/op/stash.t
+++ b/t/op/stash.t
@@ -7,12 +7,12 @@ BEGIN {
BEGIN { require "./test.pl"; }
-plan( tests => 58 );
+plan( tests => 59 );
-# Used to segfault (bug #15479)
+# Used to segfault (bug #15479 and #54044)
fresh_perl_like(
'%:: = ""',
- qr/Odd number of elements in hash assignment at - line 1\./,
+ qr/^Attempt to clear the %main:: symbol table at - line 1\./,
{ switches => [ '-w' ] },
'delete $::{STDERR} and print a warning',
);
@@ -60,7 +60,7 @@ package main;
local $ENV{PERL_DESTRUCT_LEVEL} = 2;
fresh_perl_is(
'package A; sub a { // }; %::=""',
- '',
+ 'Attempt to clear the current symbol table at - line 1.',
'',
);
# Variant of the above which creates an object that persists until global
@@ -336,3 +336,11 @@ ok eval '
sub foo{};
1
', 'no crashing or errors when clobbering the current package';
+
+{
+ # [perl #54004] disallow setting i.e. clearing %main::
+ eval '%::=()';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval '%main:: = ($_ = "")';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+}
diff --git a/t/op/undef.t b/t/op/undef.t
index eafa6db..fa4cdfc 100644
--- a/t/op/undef.t
+++ b/t/op/undef.t
@@ -10,7 +10,7 @@ use strict;
use vars qw(@ary %ary %hash);
-plan 85;
+plan 90;
ok !defined($a);
@@ -176,3 +176,17 @@ sub PVBM () { 'foo' }
my $pvbm = PVBM;
undef $pvbm;
ok !defined $pvbm;
+
+{
+ # [perl #54004] disallow undef %main::
+ eval 'undef %::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval 'undef %main::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval 'undef %main::main::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval 'package A; undef %main::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval 'package A; undef %::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+}
--------------1.7.10.4--
---
This perlbug was built using Perl 5.17.3 - Mon Jul 30 16:28:27 CDT 2012 Site configuration information for perl 5.14.2: Configured by rurban at Wed Oct 26 17:33:43 CDT 2011. Summary of my perl5 (revision 5 version 14 subversion 2) configuration: Platform: Locally applied patches: @INC for perl 5.14.2: Environment for perl 5.14.2: -- |
From @rurbanOops, previous patch had a last minute typo in it (sv vs hv) Use this one instead. On Mon Apr 08 10:22:20 2013, rurban wrote:
-- |
From @rurban0001-Error-Attempt-to-clear-the-main-symbol-table-perl-54.patchFrom 54fb05a34547efb1a4c76db0f77d5d154be13cde Mon Sep 17 00:00:00 2001
From: Reini Urban <rurban@x-ray.at>
Date: Mon, 8 Apr 2013 12:02:17 -0500
Subject: [PATCH] Error "Attempt to clear the %main:: symbol table" [perl
#54044]
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="------------1.7.10.4"
This is a multi-part message in MIME format.
--------------1.7.10.4
Content-Type: text/plain; charset=UTF-8; format=fixed
Content-Transfer-Encoding: 8bit
Perl used to crash when the %main:: stash is undef'ed or cleared and some
magic to be expected symbol is accessed, such as perl -wle '%::=();//'
with PL_replgv.
Check both cases: undef and assignment in hv_clear()/sv_clear().
---
hv.c | 4 ++++
pod/perldiag.pod | 9 +++++++++
sv.c | 2 ++
t/op/stash.t | 16 ++++++++++++----
t/op/undef.t | 16 +++++++++++++++-
5 files changed, 42 insertions(+), 5 deletions(-)
--------------1.7.10.4
Content-Type: text/x-patch; name="0001-Error-Attempt-to-clear-the-main-symbol-table-perl-54.patch"
Content-Transfer-Encoding: 8bit
Content-Disposition: attachment; filename="0001-Error-Attempt-to-clear-the-main-symbol-table-perl-54.patch"
diff --git a/hv.c b/hv.c
index ec1bfe8..4e93315 100644
--- a/hv.c
+++ b/hv.c
@@ -1469,6 +1469,8 @@ Perl_hv_clear(pTHX_ HV *hv)
xhv = (XPVHV*)SvANY(hv);
ENTER;
+ if ( hv == PL_defstash && PL_phase != PERL_PHASE_DESTRUCT )
+ croak("Attempt to clear the %main:: symbol table");
SAVEFREESV(SvREFCNT_inc_simple_NN(hv));
if (SvREADONLY(hv) && HvARRAY(hv) != NULL) {
/* restricted hash: convert all keys to placeholders */
@@ -1706,6 +1708,8 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
/* note that the code following prior to hfreeentries is duplicated
* in sv_clear(), and changes here should be done there too */
if (PL_phase != PERL_PHASE_DESTRUCT && (name = HvNAME(hv))) {
+ if (hv == PL_defstash)
+ croak("Attempt to clear the %main:: symbol table");
if (PL_stashcache) {
DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for '%"
HEKf"'\n", HvNAME_HEK(hv)));
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index f7eb662..f3fb28b 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -277,6 +277,15 @@ example by:
bless $self, "$proto";
+=item Attempt to clear the %main:: symbol table
+
+(F) The failing code attempted to delete or set the C<%main::>
+symboltable, with something like C<%::=()> or C<undef %::>. If you
+want to really clear all entries from the C<%main::> symboltable you
+need to do it manually, element by element. But beware that a lot of
+magic main symbols entries are required, e.g. for the regex engine,
+and all namespaces will be gone also, as they are keys of C<%main::>.
+
=item Attempt to clear deleted array
(S debugging) An array was assigned to when it was being freed.
diff --git a/sv.c b/sv.c
index 3736ba8..ffdb48d 100644
--- a/sv.c
+++ b/sv.c
@@ -6120,6 +6120,8 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
/* Free back-references before magic, in case the magic calls
* Perl code that has weak references to sv. */
if (type == SVt_PVHV) {
+ if (PL_phase != PERL_PHASE_DESTRUCT && MUTABLE_HV(sv) == PL_defstash)
+ croak("Attempt to clear the %main:: symbol table");
Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv));
if (SvMAGIC(sv))
mg_free(sv);
diff --git a/t/op/stash.t b/t/op/stash.t
index fd5450e..fd9392c 100644
--- a/t/op/stash.t
+++ b/t/op/stash.t
@@ -7,12 +7,12 @@ BEGIN {
BEGIN { require "./test.pl"; }
-plan( tests => 58 );
+plan( tests => 59 );
-# Used to segfault (bug #15479)
+# Used to segfault (bug #15479 and #54044)
fresh_perl_like(
'%:: = ""',
- qr/Odd number of elements in hash assignment at - line 1\./,
+ qr/^Attempt to clear the %main:: symbol table at - line 1\./,
{ switches => [ '-w' ] },
'delete $::{STDERR} and print a warning',
);
@@ -60,7 +60,7 @@ package main;
local $ENV{PERL_DESTRUCT_LEVEL} = 2;
fresh_perl_is(
'package A; sub a { // }; %::=""',
- '',
+ 'Attempt to clear the current symbol table at - line 1.',
'',
);
# Variant of the above which creates an object that persists until global
@@ -336,3 +336,11 @@ ok eval '
sub foo{};
1
', 'no crashing or errors when clobbering the current package';
+
+{
+ # [perl #54004] disallow setting i.e. clearing %main::
+ eval '%::=()';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval '%main:: = ($_ = "")';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+}
diff --git a/t/op/undef.t b/t/op/undef.t
index eafa6db..fa4cdfc 100644
--- a/t/op/undef.t
+++ b/t/op/undef.t
@@ -10,7 +10,7 @@ use strict;
use vars qw(@ary %ary %hash);
-plan 85;
+plan 90;
ok !defined($a);
@@ -176,3 +176,17 @@ sub PVBM () { 'foo' }
my $pvbm = PVBM;
undef $pvbm;
ok !defined $pvbm;
+
+{
+ # [perl #54004] disallow undef %main::
+ eval 'undef %::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval 'undef %main::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval 'undef %main::main::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval 'package A; undef %main::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval 'package A; undef %::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+}
--------------1.7.10.4--
|
From @rurbanOn Mon Apr 08 11:36:23 2013, rurban wrote:
Smoked my cpan successfully with this revised patch. -- |
From @rurban0001-Error-Attempt-to-clear-the-main-symbol-table-perl-54.patchFrom 7ae6b9039b8f7d695148312ef46e4cc841e45d57 Mon Sep 17 00:00:00 2001
From: Reini Urban <rurban@x-ray.at>
Date: Mon, 8 Apr 2013 12:02:17 -0500
Subject: [PATCH] Error "Attempt to clear the %main:: symbol table" [perl
#54044]
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="------------1.7.10.4"
This is a multi-part message in MIME format.
--------------1.7.10.4
Content-Type: text/plain; charset=UTF-8; format=fixed
Content-Transfer-Encoding: 8bit
Perl used to crash when the %main:: stash is undef'ed or cleared and some
magic to be expected symbol is accessed, such as perl -wle '%::=();//'
with PL_replgv.
Check both cases: undef and assignment in hv_clear()/sv_clear().
---
hv.c | 4 ++++
pod/perldiag.pod | 9 +++++++++
sv.c | 2 ++
t/op/stash.t | 18 +++++++++++++-----
t/op/undef.t | 16 +++++++++++++++-
5 files changed, 43 insertions(+), 6 deletions(-)
--------------1.7.10.4
Content-Type: text/x-patch; name="0001-Error-Attempt-to-clear-the-main-symbol-table-perl-54.patch"
Content-Transfer-Encoding: 8bit
Content-Disposition: attachment; filename="0001-Error-Attempt-to-clear-the-main-symbol-table-perl-54.patch"
diff --git a/hv.c b/hv.c
index ec1bfe8..4e93315 100644
--- a/hv.c
+++ b/hv.c
@@ -1469,6 +1469,8 @@ Perl_hv_clear(pTHX_ HV *hv)
xhv = (XPVHV*)SvANY(hv);
ENTER;
+ if ( hv == PL_defstash && PL_phase != PERL_PHASE_DESTRUCT )
+ croak("Attempt to clear the %main:: symbol table");
SAVEFREESV(SvREFCNT_inc_simple_NN(hv));
if (SvREADONLY(hv) && HvARRAY(hv) != NULL) {
/* restricted hash: convert all keys to placeholders */
@@ -1706,6 +1708,8 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
/* note that the code following prior to hfreeentries is duplicated
* in sv_clear(), and changes here should be done there too */
if (PL_phase != PERL_PHASE_DESTRUCT && (name = HvNAME(hv))) {
+ if (hv == PL_defstash)
+ croak("Attempt to clear the %main:: symbol table");
if (PL_stashcache) {
DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for '%"
HEKf"'\n", HvNAME_HEK(hv)));
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index f7eb662..f3fb28b 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -277,6 +277,15 @@ example by:
bless $self, "$proto";
+=item Attempt to clear the %main:: symbol table
+
+(F) The failing code attempted to delete or set the C<%main::>
+symboltable, with something like C<%::=()> or C<undef %::>. If you
+want to really clear all entries from the C<%main::> symboltable you
+need to do it manually, element by element. But beware that a lot of
+magic main symbols entries are required, e.g. for the regex engine,
+and all namespaces will be gone also, as they are keys of C<%main::>.
+
=item Attempt to clear deleted array
(S debugging) An array was assigned to when it was being freed.
diff --git a/sv.c b/sv.c
index 3736ba8..ffdb48d 100644
--- a/sv.c
+++ b/sv.c
@@ -6120,6 +6120,8 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
/* Free back-references before magic, in case the magic calls
* Perl code that has weak references to sv. */
if (type == SVt_PVHV) {
+ if (PL_phase != PERL_PHASE_DESTRUCT && MUTABLE_HV(sv) == PL_defstash)
+ croak("Attempt to clear the %main:: symbol table");
Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv));
if (SvMAGIC(sv))
mg_free(sv);
diff --git a/t/op/stash.t b/t/op/stash.t
index fd5450e..a5bea3e 100644
--- a/t/op/stash.t
+++ b/t/op/stash.t
@@ -7,12 +7,12 @@ BEGIN {
BEGIN { require "./test.pl"; }
-plan( tests => 58 );
+plan( tests => 60 );
-# Used to segfault (bug #15479)
+# Used to segfault (bug #15479 and #54044)
fresh_perl_like(
'%:: = ""',
- qr/Odd number of elements in hash assignment at - line 1\./,
+ qr/^Attempt to clear the %main:: symbol table at - line 1\./m,
{ switches => [ '-w' ] },
'delete $::{STDERR} and print a warning',
);
@@ -60,14 +60,14 @@ package main;
local $ENV{PERL_DESTRUCT_LEVEL} = 2;
fresh_perl_is(
'package A; sub a { // }; %::=""',
- '',
+ 'Attempt to clear the %main:: symbol table at - line 1.',
'',
);
# Variant of the above which creates an object that persists until global
# destruction.
fresh_perl_is(
'use Exporter; package A; sub a { // }; %::=""',
- '',
+ 'Attempt to clear the %main:: symbol table at - line 1.',
'',
);
}
@@ -336,3 +336,11 @@ ok eval '
sub foo{};
1
', 'no crashing or errors when clobbering the current package';
+
+{
+ # [perl #54004] disallow setting i.e. clearing %main::
+ eval '%::=()';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval '%main:: = ($_ = "")';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+}
diff --git a/t/op/undef.t b/t/op/undef.t
index eafa6db..fa4cdfc 100644
--- a/t/op/undef.t
+++ b/t/op/undef.t
@@ -10,7 +10,7 @@ use strict;
use vars qw(@ary %ary %hash);
-plan 85;
+plan 90;
ok !defined($a);
@@ -176,3 +176,17 @@ sub PVBM () { 'foo' }
my $pvbm = PVBM;
undef $pvbm;
ok !defined $pvbm;
+
+{
+ # [perl #54004] disallow undef %main::
+ eval 'undef %::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval 'undef %main::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval 'undef %main::main::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval 'package A; undef %main::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+ eval 'package A; undef %::';
+ like $@, qr/^Attempt to clear the %main:: symbol table/;
+}
--------------1.7.10.4--
|
From @tseeOn 04/08/2013 11:27 PM, Reini Urban via RT wrote:
FWIW if nobody beats me to it or strongly objects I'll try to remember --Steffen |
From @HugmeirOn Tue, Apr 9, 2013 at 2:03 AM, Steffen Mueller <smueller@cpan.org> wrote:
My soft objection is that it doesn't really solve the underlaying issue, it |
From @HugmeirAnother objection, I don't think either of these should fail: $ ./perl -e '%:: = %::' $ ./perl -e '%:: = map { On Tue, Apr 9, 2013 at 2:09 AM, Brian Fraser <fraserbn@gmail.com> wrote:
|
From @nwc10On Wed, Apr 10, 2013 at 06:48:23AM -0300, Brian Fraser wrote:
Given how hash list assignment is implemented, it's hard to see how to I can see that they are reduced test cases, but what's the real world Nicholas Clark |
From @HugmeirOn Wed, Apr 10, 2013 at 7:04 AM, Nicholas Clark <nick@ccl4.org> wrote:
Ah. Good question; None productive from me. I've only used them in joke |
From @nwc10On Mon, Apr 08, 2013 at 02:27:04PM -0700, Reini Urban via RT wrote:
Mmm, that's an interesting failure case that I'd not thought of.
I don't think that these three should be changed like that. Clearing %:: Inline Patchdiff --git a/t/op/stash.t b/t/op/stash.t
index fd5450e..2681d47 100644
--- a/t/op/stash.t
+++ b/t/op/stash.t
@@ -11,7 +11,7 @@ plan( tests => 58 );
# Used to segfault (bug #15479)
fresh_perl_like(
- '%:: = ""',
+ 'delete $::{STDERR}; my %a = ""',
qr/Odd number of elements in hash assignment at - line 1\./,
{ switches => [ '-w' ] },
'delete $::{STDERR} and print a warning',
@@ -59,14 +59,15 @@ package main;
{
local $ENV{PERL_DESTRUCT_LEVEL} = 2;
fresh_perl_is(
- 'package A; sub a { // }; %::=""',
+ 'package A::B; sub a { // }; %A::=""',
'',
'',
);
# Variant of the above which creates an object that persists until global
- # destruction.
+ # destruction, and triggers an assertion failure prior to change
+ # a420522db95b7762
fresh_perl_is(
- 'use Exporter; package A; sub a { // }; %::=""',
+ 'use Exporter; package A; sub a { // }; delete $::{$_} for keys %::',
'',
'',
);
Verified. In that I built the 3 revisions where those 3 were added and I sort of assume that "code freeze" applies equally to the code that is tests, Nicholas Clark |
From @nwc10On Wed, Apr 10, 2013 at 12:13:37PM +0100, Nicholas Clark wrote:
*That* change is now in blead, but the rest of this ticket is not yet done. Nicholas Clark |
From @cpansproutOn Wed Apr 10 03:51:04 2013, Hugmeir wrote:
Another objection: It doesn’t fix the underlying issue, and it just adds a special case to prevent something that nobody does anyway (and the extra check will make every %hash=() marginally slower). I think the real fix here is to make certain shortcut pointers (like PL_replgv) reference-counted as necessary. I have already begun this. I started for a different purpose; namely, to prevent gv_try_downgrade from trying to delete these (yes, it can do that!). Once that’s done, I think this ticket can be closed. -- Father Chrysostomos |
From @cpansproutOn Sun Oct 27 16:23:04 2013, sprout wrote:
I forgot to mention: If someone removes, say, $::{ENV} and expects *{"ENV"} to work thereafter, that’s not our problem. That counts as podotoxoboly (with apologies to Damian Conway). -- Father Chrysostomos |
From jettero@cpan.orgApologies if this is a stupid question, but I can't figure why I'm copied Is this the best place to find the full history? http://www.nntp.perl.org/group/perl.perl5.porters/2013/04/msg200892.html On Sun, Oct 27, 2013 at 7:23 PM, Father Chrysostomos via RT <
-- |
From @ap* Father Chrysostomos via RT <perlbug-followup@perl.org> [2013-10-28 00:45]:
Quoth `man bash` describing `unset`: If any of RANDOM, SECONDS, LINENO, HISTCMD, FUNCNAME, GROUPS, or So assuming that I am making the right connection here, the sentiment -- |
From @SmylersPaul Miller writes:
Hi Paul. At the very bottom of Father Chrysostomos's message that you Reading down it seems you first reported Bug 54050, which was then Smylers |
From jettero@cpan.orgOn Mon Oct 28 00:23:37 2013, smylers@stripey.com wrote:
It's actually not on his. I looked at that first thing (then checked the raw copy after you said to see if gmail hid it somehow), as I expected it would be if it was from RT. I think he replied in another way. But all I had to do was put 54044 into the regular old rt.perl.org? I feel silly regardless. Looks like I did report this at one point. I wonder how I found that. |
From @Smylersjettero@cpan.org via RT writes:
In which case, my apologies for suggesting otherwise.
It was via RT, but possibly RT sends different messages to ‘internal’
Please don't feel silly: I don't see why it would be obvious to somebody Cheers Smylers |
From @cpansproutOn Sun Oct 27 16:23:04 2013, sprout wrote:
This is now fixed in commit 475b1e9 and some of the commits leading up to it. -- Father Chrysostomos |
|
@cpansprout - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#54044 (status was 'resolved')
Searchable as RT54044$
The text was updated successfully, but these errors were encountered: