In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/9407f9c16f7d184b9b5524ddf3659d961e6a5f14?hp=ab08a362aba1ac5dacd58ee13d77e9faf693e7e3>

- Log -----------------------------------------------------------------
commit 9407f9c16f7d184b9b5524ddf3659d961e6a5f14
Author: David Leadbeater <[email protected]>
Date:   Sun Mar 6 15:19:57 2011 +0000

    Fix [perl #85508] regression in print length undef
    
    length was returning a temporary copy of undef, this meant it didn't
    generate a warning when used uninitialised. Return PL_sv_undef but
    also ensure TARG is cleared if needed.
-----------------------------------------------------------------------

Summary of changes:
 pp.c          |   14 ++++++++++----
 t/op/length.t |   13 ++++++++++---
 2 files changed, 20 insertions(+), 7 deletions(-)

diff --git a/pp.c b/pp.c
index d6f0332..4bf4b18 100644
--- a/pp.c
+++ b/pp.c
@@ -3330,8 +3330,11 @@ PP(pp_length)
                           SV_UNDEF_RETURNS_NULL|SV_CONST_RETURN|SV_GMAGIC);
 
        if (!p) {
-           sv_setsv(TARG, &PL_sv_undef);
-           SETTARG;
+           if (!SvPADTMP(TARG)) {
+               sv_setsv(TARG, &PL_sv_undef);
+               SETTARG;
+           }
+           SETs(&PL_sv_undef);
        }
        else if (DO_UTF8(sv)) {
            SETi(utf8_length((U8*)p, (U8*)p + len));
@@ -3345,8 +3348,11 @@ PP(pp_length)
        else
            SETi(sv_len(sv));
     } else {
-       sv_setsv_nomg(TARG, &PL_sv_undef);
-       SETTARG;
+       if (!SvPADTMP(TARG)) {
+           sv_setsv_nomg(TARG, &PL_sv_undef);
+           SETTARG;
+       }
+       SETs(&PL_sv_undef);
     }
     RETURN;
 }
diff --git a/t/op/length.t b/t/op/length.t
index 705b9d5..0288bec 100644
--- a/t/op/length.t
+++ b/t/op/length.t
@@ -6,7 +6,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-plan (tests => 36);
+plan (tests => 37);
 
 print "not " unless length("")    == 0;
 print "ok 1\n";
@@ -210,11 +210,18 @@ is($ul, undef, "Assigned length of overloaded undef with 
result in TARG");
 
 # ok(!defined $uo); Turns you can't test this. FIXME for pp_defined?
 
-is($warnings, 0, "There were no warnings");
-
 {
     my $y = "\x{100}BC";
     is(index($y, "B"), 1, 'adds an intermediate position to the offset cache');
     is(length $y, 3,
        'Check that sv_len_utf8() can take advantage of the offset cache');
 }
+
+{
+    local $SIG{__WARN__} = sub {
+        pass("'print length undef' warned");
+    };
+    print length undef;
+}
+
+is($warnings, 0, "There were no other warnings");

--
Perl5 Master Repository

Reply via email to