This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Parsing fix: it wasn't possible to call a function with a (_) prototype
[perl5.git] / t / comp / uproto.t
CommitLineData
b13fd70a
RGS
1#!perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6 require "./test.pl";
7}
8
3cd0a11a 9plan(tests => 39);
b13fd70a
RGS
10
11sub f($$_) { my $x = shift; is("@_", $x) }
12
13$foo = "FOO";
14my $bar = "BAR";
15$_ = 42;
16
17f("FOO xy", $foo, "xy");
18f("BAR zt", $bar, "zt");
19f("FOO 42", $foo);
20f("BAR 42", $bar);
21f("y 42", substr("xy",1,1));
22f("1 42", ("abcdef" =~ /abc/));
23f("not undef 42", $undef || "not undef");
24f(" 42", -f "no_such_file");
25f("FOOBAR 42", ($foo . $bar));
26f("FOOBAR 42", ($foo .= $bar));
27f("FOOBAR 42", $foo);
28
29eval q{ f("foo") };
30like( $@, qr/Not enough arguments for main::f at/ );
31eval q{ f(1,2,3,4) };
32like( $@, qr/Too many arguments for main::f at/ );
33
236b555a
RGS
34{
35 my $_ = "quarante-deux";
36 $foo = "FOO";
37 $bar = "BAR";
38 f("FOO quarante-deux", $foo);
39 f("BAR quarante-deux", $bar);
40 f("y quarante-deux", substr("xy",1,1));
41 f("1 quarante-deux", ("abcdef" =~ /abc/));
42 f("not undef quarante-deux", $undef || "not undef");
43 f(" quarante-deux", -f "no_such_file");
44 f("FOOBAR quarante-deux", ($foo . $bar));
45 f("FOOBAR quarante-deux", ($foo .= $bar));
46 f("FOOBAR quarante-deux", $foo);
47}
48
b13fd70a
RGS
49&f(""); # no error
50
236b555a
RGS
51sub g(_) { is(shift, $expected) }
52
53$expected = "foo";
54g("foo");
55g($expected);
56$_ = $expected;
57g();
3cd0a11a 58g;
236b555a
RGS
59undef $expected; &g; # $_ not passed
60{ $expected = my $_ = "bar"; g() }
f00d1d61
RGS
61
62eval q{ sub wrong1 (_$); wrong1(1,2) };
63like( $@, qr/Malformed prototype for main::wrong1/, 'wrong1' );
64
65eval q{ sub wrong2 ($__); wrong2(1,2) };
66like( $@, qr/Malformed prototype for main::wrong2/, 'wrong2' );
5df4b323
RGS
67
68sub opt ($;_) { is($_[0], "seen"); ok(!defined $_[1], "; has precedence over _") }
69opt("seen");
bfd79223 70
cb40c25d 71sub unop (_) { is($_[0], 11, "unary op") }
bfd79223 72unop 11, 22; # takes only the first parameter into account
cb40c25d
RGS
73
74sub mymkdir (_;$) { is("@_", $expected, "mymkdir") }
75$expected = $_ = "mydir"; mymkdir();
76mymkdir($expected = "foo");
77$expected = "foo 493"; mymkdir foo => 0755;
6a8363ef
RGS
78
79# $_ says modifiable, it's not passed by copy
80
81sub double(_) { $_[0] *= 2 }
82$_ = 21;
83double();
84is( $_, 42, '$_ is modifiable' );
85{
86 my $_ = 22;
87 double();
88 is( $_, 44, 'my $_ is modifiable' );
89}