allow undef as an arg to '&' prototype

RT #123475

Commit e41e9865be5555 (to fix [perl #123062]) restricted the types of
args allowed for a function with a '&' prototype - previously it allowed
array refs and the like. It also removed undef, so this was now a
compile-time error:

    sub foo (&) {...}
    foo(undef)

However, some CPAN code used the idiom register_callback(undef) to
explicitly disable a registered callback.

So re-allow an explicit undef.

diff --git a/op.c b/op.c
index 91ab762..cab214a 100644 (file)
--- a/op.c
+++ b/op.c
@@ -11417,11 +11417,12 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
            case '&':
                proto++;
                arg++;
-               if (o3->op_type != OP_SREFGEN
-                || (  cUNOPx(cUNOPx(o3)->op_first)->op_first->op_type
-                       != OP_ANONCODE
-                   && cUNOPx(cUNOPx(o3)->op_first)->op_first->op_type
-                       != OP_RV2CV))
+               if (    o3->op_type != OP_UNDEF
+                    && (o3->op_type != OP_SREFGEN
+                        || (  cUNOPx(cUNOPx(o3)->op_first)->op_first->op_type
+                                != OP_ANONCODE
+                            && cUNOPx(cUNOPx(o3)->op_first)->op_first->op_type
+                                != OP_RV2CV)))
                    bad_type_gv(arg, namegv, o3,
                            arg == 1 ? "block or sub {}" : "sub {}");
                break;

diff --git a/t/comp/proto.t b/t/comp/proto.t
index 2b983f5..39891b4 100644 (file)
--- a/t/comp/proto.t
+++ b/t/comp/proto.t
@@ -278,6 +278,7 @@ testing \&a_sub, '&';
 
 sub a_sub (&) {
     print "# \@_ = (",join(",",@_),")\n";
+    return unless defined $_[0];
     &{$_[0]};
 }
 
@@ -304,7 +305,7 @@ eval 'a_sub \($list, %of, @refs)';
 print "not " unless $@ =~ /Type of arg/;
 printf "ok %d\n",$i++;
 eval 'a_sub undef';
-print "not " unless $@ =~ /Type of arg/;
+print "not " if $@;
 printf "ok %d\n",$i++;
 
 ##