Cloning a format whose outside has been undefined

This has crashed ever since 71f882da8, because the format tries to
close over a pad that does not exist:

sub x {
    {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)}
    my $z;
    format =
@<<<
$z
.
}
undef &x;
write;

This commit adds checks for nonexistent pads, producing the ‘Variable
is not available’ warning in cases like this.

(cherry-picked from f2ead8b)

2 files changed, 28 insertions, 6 deletions

diff --git a/pad.c b/pad.c
index 4f0cfb8460..c70ca08ba6 100644
--- a/pad.c
+++ b/pad.c
@@ -1903,7 +1903,7 @@ Perl_cv_clone(pTHX_ CV *proto)
     assert(depth || SvTYPE(proto) == SVt_PVFM);
     if (!depth)
 	depth = 1;
-    assert(CvPADLIST(outside));
+    assert(CvPADLIST(outside) || SvTYPE(proto) == SVt_PVFM);
 
     ENTER;
     SAVESPTR(PL_compcv);
@@ -1934,18 +1934,20 @@ Perl_cv_clone(pTHX_ CV *proto)
 
     PL_curpad = AvARRAY(PL_comppad);
 
-    outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
+    outpad = CvPADLIST(outside)
+	? AvARRAY(AvARRAY(CvPADLIST(outside))[depth])
+	: NULL;
 
     for (ix = fpad; ix > 0; ix--) {
 	SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
 	SV *sv = NULL;
 	if (namesv && namesv != &PL_sv_undef) { /* lexical */
 	    if (SvFAKE(namesv)) {   /* lexical from outside? */
-		sv = outpad[PARENT_PAD_INDEX(namesv)];
-		/* formats may have an inactive parent,
+		/* formats may have an inactive, or even undefined, parent,
 		   while my $x if $false can leave an active var marked as
 		   stale. And state vars are always available */
-		if (!sv || (SvPADSTALE(sv) && !SvPAD_STATE(namesv))) {
+		if (!outpad || !(sv = outpad[PARENT_PAD_INDEX(namesv)])
+		 || (SvPADSTALE(sv) && !SvPAD_STATE(namesv))) {
 		    Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
 				   "Variable \"%"SVf"\" is not available", namesv);
 		    sv = NULL;
diff --git a/t/comp/form_scope.t b/t/comp/form_scope.t
index ac106e8618..d4b5eddeb6 100644
--- a/t/comp/form_scope.t
+++ b/t/comp/form_scope.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..5\n";
+print "1..7\n";
 
 # Tests bug #22977.  Test case from Dave Mitchell.
 sub f ($);
@@ -74,3 +74,23 @@ defined $x ? "not ok 4 - $x" : "ok 4"
   print "not " unless $w =~ /^Variable "\$x" is not available at/;
   print "ok 5 - closure var not available when outer sub is inactive\n";
 }
+
+# Cloning a format whose outside has been undefined
+sub x {
+    {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)}
+    my $z;
+    format STDOUT6 =
+@<<<<<<<<<<<<<<<<<<<<<<<<<
+defined $z ? "not ok 6 - $z" : "ok 6"
+.
+}
+undef &x;
+*STDOUT = *STDOUT6{FORMAT};
+{
+  local $^W = 1;
+  my $w;
+  local $SIG{__WARN__} = sub { $w = shift };
+  write;
+  print "not " unless $w =~ /^Variable "\$z" is not available at/;
+  print "ok 7 - closure var not available when outer sub is undefined\n";
+}