Re: [perl #19566] Perl 5.8.0 segfault
Stephen McCamant [Thu, 2 Jan 2003 18:08:23 +0000 (13:08 -0500)]
Message-ID: <15892.50791.692636.982873@syllepsis.MIT.EDU>
Plus a test by Jarkko
Integrated from changes 18444 and 18446 from maint-5.8

p4raw-id: //depot/perl@18485
p4raw-branched: from //depot/maint-5.8/perl@18484 'branch in'
t/op/readline.t
p4raw-integrated: from //depot/maint-5.8/perl@18446 'merge in' MANIFEST
(@18436..)
p4raw-integrated: from //depot/maint-5.8/perl@18444 'merge in' pp_hot.c
(@18173..)

MANIFEST
pp_hot.c
t/op/readline.t [new file with mode: 0644]

index e8c8e66..9ebb6a6 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2601,6 +2601,7 @@ t/op/quotemeta.t          See if quotemeta works
 t/op/rand.t                    See if rand works
 t/op/range.t                   See if .. works
 t/op/read.t                    See if read() works
+t/op/readline.t                        See if <> / readline work
 t/op/readdir.t                 See if readdir() works
 t/op/recurse.t                 See if deep recursion works
 t/op/ref.t                     See if refs and objects work
index 24d26d7..461c666 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1466,6 +1466,8 @@ Perl_do_readline(pTHX)
                report_evil_fh(PL_last_in_gv, io, PL_op->op_type);
        }
        if (gimme == G_SCALAR) {
+           /* undef TARG, and push that undefined value */
+           SV_CHECK_THINKFIRST_COW_DROP(TARG);
            (void)SvOK_off(TARG);
            PUSHTARG;
        }
@@ -1527,6 +1529,7 @@ Perl_do_readline(pTHX)
                }
            }
            if (gimme == G_SCALAR) {
+               SV_CHECK_THINKFIRST_COW_DROP(TARG);
                (void)SvOK_off(TARG);
                SPAGAIN;
                PUSHTARG;
diff --git a/t/op/readline.t b/t/op/readline.t
new file mode 100644 (file)
index 0000000..ae04312
--- /dev/null
@@ -0,0 +1,13 @@
+#!./perl
+
+BEGIN {
+    chdir 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+plan tests => 1;
+
+eval { for (\2) { $_ = <FH> } };
+like($@, 'Modification of a read-only value attempted', '[perl #19566]');
+