diff options
| -rw-r--r-- | ext/B/B/Concise.pm | 2 | ||||
| -rw-r--r-- | op.c | 11 | ||||
| -rw-r--r-- | pp_hot.c | 5 | ||||
| -rwxr-xr-x | t/op/closure.t | 9 | ||||
| -rwxr-xr-x | t/op/sub_lval.t | 4 |
5 files changed, 22 insertions, 9 deletions
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 11660883c1..7cd198e55d 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -532,7 +532,7 @@ sub tree { # Why these are different for MacOS? Does it matter? my $cop_seq_mnum = $^O eq 'MacOS' ? 12 : 11; -my $seq_mnum = $^O eq 'MacOS' ? 100 : 84; +my $seq_mnum = $^O eq 'MacOS' ? 102 : 86; $cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + $cop_seq_mnum; $seq_base = svref_2object(eval 'sub{}')->START->seq + $seq_mnum; @@ -1756,9 +1756,14 @@ Perl_block_end(pTHX_ I32 floor, OP *seq) { int needblockscope = PL_hints & HINT_BLOCK_SCOPE; line_t copline = PL_copline; - /* there should be a nextstate in every block */ - OP* retval = seq ? scalarseq(seq) : newSTATEOP(0, Nullch, seq); - PL_copline = copline; /* XXX newSTATEOP may reset PL_copline */ + OP* retval = scalarseq(seq); + if (!seq) { + /* scalarseq() gave us an OP_STUB */ + retval->op_flags |= OPf_PARENS; + /* there should be a nextstate in every block */ + retval = newSTATEOP(0, Nullch, retval); + PL_copline = copline; /* XXX newSTATEOP may reset PL_copline */ + } LEAVE_SCOPE(floor); PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK); if (needblockscope) @@ -2317,8 +2317,9 @@ PP(pp_leavesublv) PL_curpm = newpm; LEAVE; LEAVESUB(sv); - DIE(aTHX_ "Can't return a %s from lvalue subroutine", - SvREADONLY(TOPs) ? "readonly value" : "temporary"); + DIE(aTHX_ "Can't return %s from lvalue subroutine", + SvREADONLY(TOPs) ? (TOPs == &PL_sv_undef) ? "undef" + : "a readonly value" : "a temporary"); } else { /* Can be a localized value * subject to deletion. */ diff --git a/t/op/closure.t b/t/op/closure.t index d93292b925..d51d3be62b 100755 --- a/t/op/closure.t +++ b/t/op/closure.t @@ -13,7 +13,7 @@ BEGIN { use Config; -print "1..173\n"; +print "1..174\n"; my $test = 1; sub test (&) { @@ -527,3 +527,10 @@ sub { }->(); test {1}; +# [perl #17605] found that an empty block called in scalar context +# can lead to stack corruption +{ + my $x = "foooobar"; + $x =~ s/o//eg; + test { $x eq 'fbar' } +} diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t index 308269eee9..a17c3c62c5 100755 --- a/t/op/sub_lval.t +++ b/t/op/sub_lval.t @@ -251,7 +251,7 @@ eval <<'EOE' or $_ = $@; EOE print "# '$_'.\nnot " - unless /Empty array returned from lvalue subroutine in scalar context/; + unless /Can't return undef from lvalue subroutine/; print "ok 31\n"; sub lv10 : lvalue {} @@ -274,7 +274,7 @@ eval <<'EOE' or $_ = $@; EOE print "# '$_'.\nnot " - unless /Can\'t return a readonly value from lvalue subroutine/; + unless /Can't return undef from lvalue subroutine/; print "ok 33\n"; $_ = undef; |