Re: [patch] [perl #21628] rcatline issue

Message-ID: <20030320203906.GA31199@ratsnest.hole>

p4raw-id: //depot/perl@19039

diff --git a/MANIFEST b/MANIFEST
index 320eae5..fe3e8f2 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2622,7 +2622,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/readline.t                        See if <> / readline / rcatline 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

diff --git a/pp_hot.c b/pp_hot.c
index eb166f9..5981a5d 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1494,8 +1494,10 @@ Perl_do_readline(pTHX)
        }
        if (gimme == G_SCALAR) {
            /* undef TARG, and push that undefined value */
-           SV_CHECK_THINKFIRST_COW_DROP(TARG);
-           (void)SvOK_off(TARG);
+           if (type != OP_RCATLINE) {
+               SV_CHECK_THINKFIRST_COW_DROP(TARG);
+               SvOK_off(TARG);
+           }
            PUSHTARG;
        }
        RETURN;
@@ -1556,8 +1558,10 @@ Perl_do_readline(pTHX)
                }
            }
            if (gimme == G_SCALAR) {
-               SV_CHECK_THINKFIRST_COW_DROP(TARG);
-               (void)SvOK_off(TARG);
+               if (type != OP_RCATLINE) {
+                   SV_CHECK_THINKFIRST_COW_DROP(TARG);
+                   SvOK_off(TARG);
+               }
                SPAGAIN;
                PUSHTARG;
            }

diff --git a/t/op/readline.t b/t/op/readline.t
index ae04312..1bc9ef4 100644 (file)
--- a/t/op/readline.t
+++ b/t/op/readline.t
@@ -6,8 +6,15 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 1;
+plan tests => 3;
 
 eval { for (\2) { $_ = <FH> } };
 like($@, 'Modification of a read-only value attempted', '[perl #19566]');
 
+{
+  open A,"+>a"; $a = 3;
+  is($a .= <A>, 3, '#21628 - $a .= <A> , A eof');
+  close A; $a = 4;
+  is($a .= <A>, 4, '#21628 - $a .= <A> , A closed');
+  unlink "a";
+}