In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/bac7a184cda7b75406b8f293e546375eae0c1693?hp=a342ef003d32febac1781449c9b9cbc1fc589a49>

- Log -----------------------------------------------------------------
commit bac7a184cda7b75406b8f293e546375eae0c1693
Author: Father Chrysostomos <[email protected]>
Date:   Wed Mar 18 21:56:46 2015 -0700

    universal.c: PERL_OP_PARENT support

M       universal.c

commit b24768f02e4adcd11668f94274f5617c4a3f5379
Author: Father Chrysostomos <[email protected]>
Date:   Wed Mar 18 02:35:50 2015 -0700

    [perl #123995] Assert fail with s;@{<<;
    
    If s;; gobbles up the implicit semicolon that is tacked on to the end
    of the file, it can confuse the here-doc parser into thinking it is
    inside a string eval, because there is no file handle.  We need to
    check for that possibility where the assertion was failing.

M       t/op/lex.t
M       toke.c
-----------------------------------------------------------------------

Summary of changes:
 t/op/lex.t  | 9 ++++++++-
 toke.c      | 9 +++++++--
 universal.c | 6 +++---
 3 files changed, 18 insertions(+), 6 deletions(-)

diff --git a/t/op/lex.t b/t/op/lex.t
index 8314f41..a4ce65c 100644
--- a/t/op/lex.t
+++ b/t/op/lex.t
@@ -7,7 +7,7 @@ use warnings;
 
 BEGIN { chdir 't' if -d 't'; require './test.pl'; }
 
-plan(tests => 24);
+plan(tests => 25);
 
 {
     no warnings 'deprecated';
@@ -202,3 +202,10 @@ fresh_perl_is(
 
 is eval "qq'@\x{ff13}'", "\@\x{ff13}",
   '"@<fullwidth digit>" [perl #123963]';
+
+fresh_perl_is(
+  "s;\@{<<a;\n",
+  "Can't find string terminator \"a\" anywhere before EOF at - line 1.\n",
+   { stderr => 1 },
+  's;@{<<a; [perl #123995]'
+);
diff --git a/toke.c b/toke.c
index 414a03a..3b60488 100644
--- a/toke.c
+++ b/toke.c
@@ -9284,8 +9284,13 @@ S_scan_heredoc(pTHX_ char *s)
               lexing scope.  In a file, we will have broken out of the
               loop in the previous iteration.  In an eval, the string buf-
               fer ends with "\n;", so the while condition above will have
-              evaluated to false.  So shared can never be null. */
-           assert(shared);
+              evaluated to false.  So shared can never be null.  Or so you
+              might think.  Odd syntax errors like s;@{<<; can gobble up
+              the implicit semicolon at the end of a flie, causing the
+              file handle to be closed even when we are not in a string
+              eval.  So shared may be null in that case.  */
+           if (UNLIKELY(!shared))
+               goto interminable;
            /* A LEXSHARED struct with a null ls_prev pointer is the outer-
               most lexing scope.  In a file, shared->ls_linestr at that
               level is just one line, so there is no body to steal. */
diff --git a/universal.c b/universal.c
index 864558f..db20cd6 100644
--- a/universal.c
+++ b/universal.c
@@ -1060,7 +1060,7 @@ optimize_out_native_convert_function(pTHX_ OP* entersubop,
     SvREFCNT_dec(prototype);
 
     pushop = cUNOPx(entersubop)->op_first;
-    if (! pushop->op_sibling) {
+    if (! OpHAS_SIBLING(pushop)) {
         pushop = cUNOPx(pushop)->op_first;
     }
     argop = pushop->op_sibling;
@@ -1068,8 +1068,8 @@ optimize_out_native_convert_function(pTHX_ OP* entersubop,
     /* Carry on without doing the optimization if it is not something we're
      * expecting, so continues to work */
     if (   ! argop
-        || ! argop->op_sibling
-        ||   argop->op_sibling->op_sibling
+        || ! OpHAS_SIBLING(argop)
+        ||   OpHAS_SIBLING(argop->op_sibling)
     ) {
         return entersubop;
     }

--
Perl5 Master Repository

Reply via email to