[perl #68560] calling closure prototype SEGVs

When a closure is created, the original sub is cloned (except that the
op tree is shared). That original sub (called the closure prototype)
is not usually accessible to perl.

An attribute handler (MODIFY_CODE_ATTRIBUTES) is passed a reference
to it, however. If that code reference is called within the attribute
handler, an ‘Undefined subroutine called’ error results, because the
op tree has not been attached yet.

If that code reference is stashed away and called after the attribute
handler returns, it will most likely crash.

This is because its pad is full of nulls.

A regular $proto->() or &$proto() call that sets up @_ will crash in
attempting to do so.

A &$proto call will bypass that, but attempting to read any lexical
variables from the containing scope will cause a crash. Any operator
that uses TARG (i.e., most of them) will crash.

So this commit puts a check for closure prototypes in pp_entersub. It
produces a new error message, ‘Closure prototype called’.

This does introduce a backward-incompatible change: code like this
used to work:

 sub MODIFY_CODE_ATTRIBUTES { $'proto = $_[1] }
 { my $x; () = sub :attr { () = $x; print "hello\n" } }
 &$'proto;

But writing a useful subroutine that tiptoes past the crashes is so
difficult that I think this breakage is acceptable.

1 files changed, 18 insertions, 0 deletions

diff --git a/t/op/attrs.t b/t/op/attrs.t
index 4e1a4c357e..b7809a8ffc 100644
--- a/t/op/attrs.t
+++ b/t/op/attrs.t
@@ -295,4 +295,22 @@ foreach my $test (@tests) {
     }
 }
 
+# [perl #68560] Calling closure prototypes (only accessible via :attr)
+{
+  package brength;
+  my $proto;
+  sub MODIFY_CODE_ATTRIBUTES { $proto = $_[1]; _: }
+  {
+     my $x;
+     () = sub :a0 { $x };
+  }
+  package main;
+  eval { $proto->() };               # used to crash in pp_entersub
+  like $@, qr/^Closure prototype called/,
+     "Calling closure proto with (no) args";
+  eval { () = &$proto };             # used to crash in pp_leavesub
+  like $@, qr/^Closure prototype called/,
+     "Calling closure proto with no @_ that returns a lexical";
+}
+
 done_testing();