[perl.git] branch sprout/misc-post-5.16, updated. v5.15.9-169-g4896648

[Father Chrysostomos]

In perl.git, the branch sprout/misc-post-5.16 has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/489664859f2f12ce7e45cfee9d447b7d2a2303b1?hp=9ccd0d411e5d3b8405164b5d8b1cc91e01c965d4>

- Log -----------------------------------------------------------------
commit 489664859f2f12ce7e45cfee9d447b7d2a2303b1
Author: Father Chrysostomos <spr...@cpan.org>
Date:   Sun Apr 22 20:35:43 2012 -0700

    pp_ctl.c:pp_goto: Don’t repeat yourself
    
    No need to say DIE three times.

M       pp_ctl.c

commit 8a8d874b036784f08d8a25907372dc959717b85b
Author: Father Chrysostomos <spr...@cpan.org>
Date:   Sun Apr 22 20:34:24 2012 -0700

    Produce the right error for goto "\0"
    
    Since we have supported for embedded nulls in strings, we shouldn’t
    be using if(*label) to see whether label has a non-zero length.
    
    It’s probably not possible to get a null into a label, but we should
    still say ‘can’t find’ rather than ‘must have’ in that case.

M       op.c
M       pp_ctl.c
M       t/op/goto.t
-----------------------------------------------------------------------

Summary of changes:
 op.c        |    9 ++++++++-
 pp_ctl.c    |   12 +++---------
 t/op/goto.t |    7 ++++++-
 3 files changed, 17 insertions(+), 11 deletions(-)

diff --git a/op.c b/op.c
index 3deb025..7cf012a 100644
--- a/op.c
+++ b/op.c
@@ -6057,11 +6057,12 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
 
     assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
 
-    if (type != OP_GOTO || label->op_type == OP_CONST) {
+    if (type != OP_GOTO) {
        /* "last()" means "last" */
        if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
            o = newOP(type, OPf_SPECIAL);
        else {
+         const_label:
            o = newPVOP(type,
                         label->op_type == OP_CONST
                             ? SvUTF8(((SVOP*)label)->op_sv)
@@ -6081,6 +6082,12 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
        if (label->op_type == OP_ENTERSUB
                && !(label->op_flags & OPf_STACKED))
            label = newUNOP(OP_REFGEN, 0, op_lvalue(label, OP_REFGEN));
+       else if (label->op_type == OP_CONST) {
+           SV * const sv = ((SVOP *)label)->op_sv;
+           STRLEN l;
+           const char *s = SvPV_const(sv,l);
+           if (l == strlen(s)) goto const_label;
+       }
        o = newUNOP(type, OPf_STACKED, label);
     }
     PL_hints |= HINT_BLOCK_SCOPE;
diff --git a/pp_ctl.c b/pp_ctl.c
index 53f22f3..3aa0204 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3044,24 +3044,18 @@ PP(pp_goto)
        else {
            label       = SvPV_const(sv, label_len);
             label_flags = SvUTF8(sv);
-           if (!(do_dump || *label))
-               DIE(aTHX_ must_have_label);
        }
     }
-    else if (PL_op->op_flags & OPf_SPECIAL) {
-       if (! do_dump)
-           DIE(aTHX_ must_have_label);
-    }
-    else {
+    else if (!(PL_op->op_flags & OPf_SPECIAL)) {
        label       = cPVOP->op_pv;
         label_flags = (cPVOP->op_private & OPpPV_IS_UTF8) ? SVf_UTF8 : 0;
         label_len   = strlen(label);
-       if (!(do_dump || *label)) DIE(aTHX_ must_have_label);
     }
+    if (!(do_dump || label_len)) DIE(aTHX_ must_have_label);
 
     PERL_ASYNC_CHECK();
 
-    if (label && *label) {
+    if (label_len) {
        OP *gotoprobe = NULL;
        bool leaving_eval = FALSE;
        bool in_block = FALSE;
diff --git a/t/op/goto.t b/t/op/goto.t
index f042f45..c9aadbc 100644
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -10,7 +10,7 @@ BEGIN {
 
 use warnings;
 use strict;
-plan tests => 83;
+plan tests => 85;
 our $TODO;
 
 my $deprecated = 0;
@@ -643,3 +643,8 @@ eval { goto "" };
 like $@, qr/^goto must have label at /, 'goto ""';
 eval { goto };
 like $@, qr/^goto must have label at /, 'argless goto';
+
+eval { my $x = "\0"; goto $x };
+like $@, qr/^Can't find label \0 at /, 'goto $x where $x begins with \0';
+eval { goto "\0" };
+like $@, qr/^Can't find label \0 at /, 'goto "\0"';

--
Perl5 Master Repository