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.

diff --git a/op.c b/op.c
index 6253462..cf1e9a9 100644 (file)
--- a/op.c
+++ b/op.c
@@ -6058,11 +6058,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)
@@ -6082,6 +6083,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..8025d58 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3044,7 +3044,7 @@ PP(pp_goto)
        else {
            label       = SvPV_const(sv, label_len);
             label_flags = SvUTF8(sv);
-           if (!(do_dump || *label))
+           if (!(do_dump || label_len))
                DIE(aTHX_ must_have_label);
        }
     }
@@ -3056,12 +3056,12 @@ PP(pp_goto)
        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 (file)
--- 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"';