[perl.git] branch blead, updated. v5.21.11-77-g8283f70

[Dave Mitchell]

In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/8283f70d81a621964815ba89abe1518130e1685c?hp=737f753477826d5b8aea4125965e48c81d274b7d>

- Log -----------------------------------------------------------------
commit 8283f70d81a621964815ba89abe1518130e1685c
Author: David Mitchell <da...@iabyn.com>
Date:   Wed May 6 11:56:47 2015 +0100

    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.
-----------------------------------------------------------------------

Summary of changes:
 op.c           | 11 ++++++-----
 t/comp/proto.t |  3 ++-
 2 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/op.c b/op.c
index 91ab762..cab214a 100644
--- 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
--- 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++;
 
 ##

--
Perl5 Master Repository