From: Father Chrysostomos <sprout@cpan.org>
Date: Mon, 23 Apr 2012 03:34:24 +0000 (-0700)
Subject: Produce the right error for goto "\0"
X-Git-Tag: upstream/5.20.0~6867
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=3532f34a665d9e3c45ae24b05a693150a285cde9;p=platform%2Fupstream%2Fperl.git

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
--- 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
--- 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
--- 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"';