From: Gurusamy Sarathy <gsar@cpan.org>
Date: Thu, 27 Apr 2000 06:28:31 +0000 (+0000)
Subject: patch from Larry to make (\&) prototype work; added tests for
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=75fc29ea54ba4d478cc0c602155e9d1eac8964e1;p=p5sagit%2Fp5-mst-13.2.git

patch from Larry to make (\&) prototype work; added tests for
the same

p4raw-id: //depot/perl@5963
---

diff --git a/op.c b/op.c
index 95aa4f2..711be2f 100644
--- a/op.c
+++ b/op.c
@@ -6262,7 +6262,9 @@ Perl_ck_subr(pTHX_ OP *o)
 		proto++;
 		arg++;
 		if (o2->op_type != OP_REFGEN && o2->op_type != OP_UNDEF)
-		    bad_type(arg, "block", gv_ename(namegv), o2);
+		    bad_type(arg,
+			arg == 1 ? "block or sub {}" : "sub {}",
+			gv_ename(namegv), o2);
 		break;
 	    case '*':
 		/* '*' allows any scalar type, including bareword */
@@ -6310,8 +6312,8 @@ Perl_ck_subr(pTHX_ OP *o)
 			bad_type(arg, "symbol", gv_ename(namegv), o2);
 		    goto wrapref;
 		case '&':
-		    if (o2->op_type != OP_RV2CV)
-			bad_type(arg, "sub", gv_ename(namegv), o2);
+		    if (o2->op_type != OP_ENTERSUB)
+			bad_type(arg, "subroutine entry", gv_ename(namegv), o2);
 		    goto wrapref;
 		case '$':
 		    if (o2->op_type != OP_RV2SV
diff --git a/t/comp/proto.t b/t/comp/proto.t
index ee17088..a77db9b 100755
--- a/t/comp/proto.t
+++ b/t/comp/proto.t
@@ -16,7 +16,7 @@ BEGIN {
 
 use strict;
 
-print "1..107\n";
+print "1..110\n";
 
 my $i = 1;
 
@@ -293,6 +293,25 @@ printf "ok %d\n",$i++;
 ##
 ##
 
+testing \&a_subx, '\&';
+
+sub a_subx (\&) {
+    print "# \@_ = (",join(",",@_),")\n";
+    &{$_[0]};
+}
+
+sub tmp_sub_2 { printf "ok %d\n",$i++ }
+a_subx &tmp_sub_2;
+
+@array = ( \&tmp_sub_2 );
+eval 'a_subx @array';
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+##
+##
+##
+
 testing \&sub_aref, '&\@';
 
 sub sub_aref (&\@) {