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

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

- Log -----------------------------------------------------------------
commit 9ccd0d411e5d3b8405164b5d8b1cc91e01c965d4
Author: Father Chrysostomos <[email protected]>
Date:   Sun Apr 22 20:19:15 2012 -0700

    [perl #111794] Make goto "" like goto ${\""}
    
    The logic was written in such a way that goto "" just happened to slip
    past all the checks and cause pp_goto to return NULL for the next op,
    which means the end of the program.
    
    goto ${\""} dies with ‘goto must have label’, so goto ""
    should as well.
    
    This also adds other tests for that error, which was apparently
    untested till now.

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

commit 09bb9596db29bfa748c0f170915f5c2948251b76
Author: Father Chrysostomos <[email protected]>
Date:   Sun Apr 22 20:00:14 2012 -0700

    Teach B::Concise about UTF8 labels

M       ext/B/B/Concise.pm

commit bb824f45742cb05847f519cd88a78d2f6c58c6ac
Author: Father Chrysostomos <[email protected]>
Date:   Sun Apr 22 19:58:26 2012 -0700

    Increase $B::Concise::VERSION to 0.90

M       ext/B/B/Concise.pm

commit 2082b6669241ae28a9db8ae4c00115ab0de09949
Author: Father Chrysostomos <[email protected]>
Date:   Sun Apr 22 15:47:38 2012 -0700

    Corrections to AUTHORS should go to perlbug

M       AUTHORS
-----------------------------------------------------------------------

Summary of changes:
 AUTHORS            |    6 +++---
 ext/B/B/Concise.pm |    3 ++-
 pp_ctl.c           |    1 +
 t/op/goto.t        |    9 ++++++++-
 4 files changed, 14 insertions(+), 5 deletions(-)

diff --git a/AUTHORS b/AUTHORS
index 0369b91..89e1d08 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -3,9 +3,9 @@
 # (hopefully) current and preferred email addresses from the commits.
 # These people have either submitted patches or suggestions, or their bug
 # reports or comments have inspired the appropriate patches.  Corrections,
-# additions, deletions welcome; send them to [email protected],
-# preferably as the output of diff(1), diff -u or diff -c between the
-# original and a corrected version of this file.
+# additions, deletions welcome; send them to [email protected], preferably
+# as the output of diff(1), diff -u or diff -c between the original and a
+# corrected version of this file.
 #
 # The use of this database for anything else than Perl development
 # is strictly forbidden.  (Passive distribution with the Perl source
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 6db2e0c..6d4b831 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp
 
 use Exporter (); # use #5
 
-our $VERSION   = "0.89";
+our $VERSION   = "0.90";
 our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw( set_style set_style_standard add_callback
                     concise_subref concise_cv concise_main
@@ -664,6 +664,7 @@ if ($] >= 5.009) {
 }
 $priv{$_}{128} = '+1' for qw "caller wantarray runcv";
 @{$priv{coreargs}}{1,2,64,128} = ('DREF1','DREF2','$MOD','MARK');
+$priv{$_}{128} = 'UTF' for qw "last redo next goto dump";
 
 our %hints; # used to display each COP's op_hints values
 
diff --git a/pp_ctl.c b/pp_ctl.c
index 8f4c103..53f22f3 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3056,6 +3056,7 @@ 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);
     }
 
     PERL_ASYNC_CHECK();
diff --git a/t/op/goto.t b/t/op/goto.t
index cb9c6b6..f042f45 100644
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -10,7 +10,7 @@ BEGIN {
 
 use warnings;
 use strict;
-plan tests => 80;
+plan tests => 83;
 our $TODO;
 
 my $deprecated = 0;
@@ -636,3 +636,10 @@ ok(
    same_prefix_labels(),
    "perl 112316: goto and labels with the same prefix doesn't get mixed up"
 );
+
+eval { my $x = ""; goto $x };
+like $@, qr/^goto must have label at /, 'goto $x where $x is empty string';
+eval { goto "" };
+like $@, qr/^goto must have label at /, 'goto ""';
+eval { goto };
+like $@, qr/^goto must have label at /, 'argless goto';

--
Perl5 Master Repository

Reply via email to