First attempt at implementing the _ prototype

p4raw-id: //depot/perl@29032

diff --git a/MANIFEST b/MANIFEST
index 3a2cbb5..736f44e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3163,6 +3163,7 @@ t/comp/redef.t                    See if we get correct warnings on redefined subs
 t/comp/require.t               See if require works
 t/comp/script.t                        See if script invocation works
 t/comp/term.t                  See if more terms work
+t/comp/uproto.t                        See if the _ prototype works
 t/comp/use.t                   See if pragmata work
 t/comp/utf.t                   See if UTFs work
 t/harness                      Finer diagnostics from test suite

diff --git a/op.c b/op.c
index fbe455e..711aa24 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7375,6 +7375,7 @@ Perl_ck_subr(pTHX_ OP *o)
                optional = 1;
                proto++;
                continue;
+           case '_':
            case '$':
                proto++;
                arg++;
@@ -7533,6 +7534,12 @@ 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 (proto && !optional && proto_end > proto &&
        (*proto != '@' && *proto != '%' && *proto != ';'))

diff --git a/t/comp/uproto.t b/t/comp/uproto.t
new file mode 100644 (file)
index 0000000..ba7dcd6
--- /dev/null
+++ b/t/comp/uproto.t
@@ -0,0 +1,36 @@
+#!perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require "./test.pl";
+}
+
+plan(tests => 14);
+
+sub f($$_) { my $x = shift; is("@_", $x) }
+
+$foo = "FOO";
+my $bar = "BAR";
+$_ = 42;
+
+f("FOO xy", $foo, "xy");
+f("BAR zt", $bar, "zt");
+f("FOO 42", $foo);
+f("BAR 42", $bar);
+f("y 42", substr("xy",1,1));
+f("1 42", ("abcdef" =~ /abc/));
+f("not undef 42", $undef || "not undef");
+f(" 42", -f "no_such_file");
+f("FOOBAR 42", ($foo . $bar));
+f("FOOBAR 42", ($foo .= $bar));
+f("FOOBAR 42", $foo);
+
+eval q{ f("foo") };
+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/ );
+
+&f(""); # no error
+
+# TODO: sub g(_) (doesn't work)

diff --git a/toke.c b/toke.c
index f9e79fc..0629099 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -6580,7 +6580,7 @@ Perl_yylex(pTHX)
                    for (p = d; *p; ++p) {
                        if (!isSPACE(*p)) {
                            d[tmp++] = *p;
-                           if (warnsyntax && !strchr("$@%*;[]&\\", *p))
+                           if (warnsyntax && !strchr("$@%*;[]&\\_", *p))
                                bad_proto = TRUE;
                        }
                    }