In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/898c3bcab476295054cadaceb5ce68aa230a2d46?hp=c2cb6f778e2defab008b04bfbd775d54b4bcb5b4>

- Log -----------------------------------------------------------------
commit 898c3bcab476295054cadaceb5ce68aa230a2d46
Author: Father Chrysostomos <[email protected]>
Date:   Mon Sep 24 16:24:54 2012 -0700

    [perl #77240] Don’t warn for --subname

M       t/lib/warnings/toke
M       toke.c

commit 87385d72ee968c05cac84105545a64b37202374d
Author: Father Chrysostomos <[email protected]>
Date:   Mon Sep 24 16:08:07 2012 -0700

    [perl #77094] Stop printf +() from reading past SP
    
    printf with an empty list was reading past the end of the stack and
    using whatever it found as its format.  If given an empty list, it
    should treat the format as "".

M       pp_sys.c
M       t/io/print.t
-----------------------------------------------------------------------

Summary of changes:
 pp_sys.c            |    3 +++
 t/io/print.t        |    7 ++++++-
 t/lib/warnings/toke |    2 ++
 toke.c              |    6 +++++-
 4 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/pp_sys.c b/pp_sys.c
index a41c6d1..68510f8 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1521,6 +1521,9 @@ PP(pp_prtf)
        = (PL_op->op_flags & OPf_STACKED) ? MUTABLE_GV(*++MARK) : PL_defoutgv;
     IO *const io = GvIO(gv);
 
+    /* Treat empty list as "" */
+    if (MARK == SP) XPUSHs(&PL_sv_no);
+
     if (io) {
        const MAGIC * const mg = SvTIED_mg((const SV *)io, 
PERL_MAGIC_tiedscalar);
        if (mg) {
diff --git a/t/io/print.t b/t/io/print.t
index 00ee7fb..4336090 100644
--- a/t/io/print.t
+++ b/t/io/print.t
@@ -10,7 +10,7 @@ BEGIN {
 
 use strict 'vars';
 
-print "1..23\n";
+print "1..24\n";
 
 my $foo = 'STDOUT';
 print $foo "ok 1\n";
@@ -71,3 +71,8 @@ if (!exists &Errno::EBADF) {
 my $n = "abc";
 printf "ok 22%n - not really a test; just printing\n", substr $n,1,1;
 print "not " x ($n ne "a5c") . "ok 23 - printf with %n (got $n)\n";
+
+# [perl #77094] printf with empty list
+() = ("not ");
+printf +();
+print "ok 24 - printf +() does not steal stack items\n";
diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index bceb536..0b540ec 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -718,6 +718,8 @@ EXPECT
 # toke.c
 sub fred {};
 -fred ;
+sub hank : lvalue {$_}
+--hank; # This should *not* warn [perl #77240]
 EXPECT
 Ambiguous use of -fred resolved as -&fred() at - line 3.
 ########
diff --git a/toke.c b/toke.c
index e0e0acd..d225514 100644
--- a/toke.c
+++ b/toke.c
@@ -6786,6 +6786,10 @@ Perl_yylex(pTHX)
          just_a_word: {
                int pkgname = 0;
                const char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : 
PL_bufptr[-1]);
+               const char penultchar =
+                   lastchar && PL_bufptr - 2 >= PL_linestart
+                        ? PL_bufptr[-2]
+                        : 0;
 #ifdef PERL_MAD
                SV *nextPL_nextwhite = 0;
 #endif
@@ -7014,7 +7018,7 @@ Perl_yylex(pTHX)
                /* Not a method, so call it a subroutine (if defined) */
 
                if (cv) {
-                   if (lastchar == '-') {
+                   if (lastchar == '-' && penultchar != '-') {
                         const SV *tmpsv = newSVpvn_flags( PL_tokenbuf, len ? 
len : strlen(PL_tokenbuf), (UTF ? SVf_UTF8 : 0) | SVs_TEMP );
                        Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
                                "Ambiguous use of -%"SVf" resolved as 
-&%"SVf"()",

--
Perl5 Master Repository

Reply via email to