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.

diff --git a/pp.c b/pp.c
index d6f0332..4bf4b18 100644 (file)
--- 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 (file)
--- 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");