close($undef) should not croak_no_modify
authorFather Chrysostomos <sprout@cpan.org>
Tue, 23 Aug 2011 21:36:46 +0000 (14:36 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 23 Aug 2011 21:36:46 +0000 (14:36 -0700)
Commit ac53db4c3f7e fixed bug #31767 (open $1 not dying), but put the
SvREADONLY check in the wrong spot, causing this bug:

$ perl -lwe 'no warnings "once"; close $x; close $+'
Name "main::x" used only once: possible typo at -e line 1.
Use of uninitialized value $x in ref-to-glob cast at -e line 1.
Modification of a read-only value attempted at -e line 1.

It shouldn’t be dying if I’m not trying to modifying it.

pp.c
t/io/open.t

diff --git a/pp.c b/pp.c
index e60f7dba0e16f421bbfadd5471a1e7f51e2bd040..865001b9a4c12969d99bc16ce23e2853429b55fd 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -169,10 +169,10 @@ PP(pp_rv2gv)
                /* If this is a 'my' scalar and flag is set then vivify
                 * NI-S 1999/05/07
                 */
-               if (SvREADONLY(sv))
-                   Perl_croak_no_modify(aTHX);
                if (PL_op->op_private & OPpDEREF) {
                    GV *gv;
+                   if (SvREADONLY(sv))
+                       Perl_croak_no_modify(aTHX);
                    if (cUNOP->op_targ) {
                        STRLEN len;
                        SV * const namesv = PAD_SV(cUNOP->op_targ);
index 57412eb7e676b1f3277df8163903cf6eb8088316..dce0e239a2d35a47764c144e40591556b2ba5fa6 100644 (file)
@@ -10,7 +10,7 @@ $|  = 1;
 use warnings;
 use Config;
 
-plan tests => 114;
+plan tests => 115;
 
 my $Perl = which_perl();
 
@@ -309,6 +309,15 @@ fresh_perl_is(
 
 eval { open $99, "foo" };
 like($@, qr/Modification of a read-only value attempted/, "readonly fh");
+# But we do not want that exception applying to close(), since it does not
+# modify the fh.
+eval {
+   no warnings "uninitialized";
+   # make sure $+ is undefined
+   "a" =~ /(b)?/;
+   close $+
+};
+is($@, '', 'no "Modification of a read-only value" when closing');
 
 # [perl#73626] mg_get wasn't run on the pipe arg