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.

2 files changed, 20 insertions, 7 deletions

diff --git a/pp.c b/pp.c
index d6f03322f2..4bf4b181f1 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 705b9d5a0c..0288bec57f 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");