From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Wed, 18 Oct 2006 12:54:34 +0000 (+0000)
Subject: Improvements and fixes to the _ prototype
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=236b555a187749e9d630e83756e3a33db4d7a249;p=p5sagit%2Fp5-mst-13.2.git

Improvements and fixes to the _ prototype

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

diff --git a/op.c b/op.c
index 711aa24..eb14e03 100644
--- a/op.c
+++ b/op.c
@@ -7534,15 +7534,15 @@ Perl_ck_subr(pTHX_ OP *o)
 	mod(o2, OP_ENTERSUB);
 	prev = o2;
 	o2 = o2->op_sibling;
-	if (o2 && o2->op_type == OP_NULL && proto && *proto == '_') {
-	    /* generate an access to $_ */
-	    o2 = newDEFSVOP();
-	    o2->op_sibling = prev->op_sibling;
-	    prev->op_sibling = o2; /* instead of cvop */
-	}
     } /* while */
+    if (o2 == cvop && proto && *proto == '_') {
+	/* generate an access to $_ */
+	o2 = newDEFSVOP();
+	o2->op_sibling = prev->op_sibling;
+	prev->op_sibling = o2; /* instead of cvop */
+    }
     if (proto && !optional && proto_end > proto &&
-	(*proto != '@' && *proto != '%' && *proto != ';'))
+	(*proto != '@' && *proto != '%' && *proto != ';' && *proto != '_'))
 	return too_few_arguments(o, gv_ename(namegv));
     if(delete_op) {
 #ifdef PERL_MAD
diff --git a/t/comp/uproto.t b/t/comp/uproto.t
index ba7dcd6..16c748a 100644
--- a/t/comp/uproto.t
+++ b/t/comp/uproto.t
@@ -6,7 +6,7 @@ BEGIN {
     require "./test.pl";
 }
 
-plan(tests => 14);
+plan(tests => 28);
 
 sub f($$_) { my $x = shift; is("@_", $x) }
 
@@ -31,6 +31,29 @@ like( $@, qr/Not enough arguments for main::f at/ );
 eval q{ f(1,2,3,4) };
 like( $@, qr/Too many arguments for main::f at/ );
 
+{
+    my $_ = "quarante-deux";
+    $foo = "FOO";
+    $bar = "BAR";
+    f("FOO quarante-deux", $foo);
+    f("BAR quarante-deux", $bar);
+    f("y quarante-deux", substr("xy",1,1));
+    f("1 quarante-deux", ("abcdef" =~ /abc/));
+    f("not undef quarante-deux", $undef || "not undef");
+    f(" quarante-deux", -f "no_such_file");
+    f("FOOBAR quarante-deux", ($foo . $bar));
+    f("FOOBAR quarante-deux", ($foo .= $bar));
+    f("FOOBAR quarante-deux", $foo);
+}
+
 &f(""); # no error
 
-# TODO: sub g(_) (doesn't work)
+sub g(_) { is(shift, $expected) }
+
+$expected = "foo";
+g("foo");
+g($expected);
+$_ = $expected;
+g();
+undef $expected; &g; # $_ not passed
+{ $expected = my $_ = "bar"; g() }