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
1 #!perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require "./test.pl";
7 }
8
9 plan(tests => 39);
10
11 sub f($$_) { my $x = shift; is("@_", $x) }
12
13 $foo = "FOO";
14 my $bar = "BAR";
15 $_ = 42;
16
17 f("FOO xy", $foo, "xy");
18 f("BAR zt", $bar, "zt");
19 f("FOO 42", $foo);
20 f("BAR 42", $bar);
21 f("y 42", substr("xy",1,1));
22 f("1 42", ("abcdef" =~ /abc/));
23 f("not undef 42", $undef || "not undef");
24 f(" 42", -f "no_such_file");
25 f("FOOBAR 42", ($foo . $bar));
26 f("FOOBAR 42", ($foo .= $bar));
27 f("FOOBAR 42", $foo);
28
29 eval q{ f("foo") };
30 like( $@, qr/Not enough arguments for main::f at/ );
31 eval q{ f(1,2,3,4) };
32 like( $@, qr/Too many arguments for main::f at/ );
33
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
49 &f(""); # no error
50
51 sub g(_) { is(shift, $expected) }
52
53 $expected = "foo";
54 g("foo");
55 g($expected);
56 $_ = $expected;
57 g();
58 g;
59 undef $expected; &g; # $_ not passed
60 { $expected = my $_ = "bar"; g() }
61
62 eval q{ sub wrong1 (_$); wrong1(1,2) };
63 like( $@, qr/Malformed prototype for main::wrong1/, 'wrong1' );
64
65 eval q{ sub wrong2 ($__); wrong2(1,2) };
66 like( $@, qr/Malformed prototype for main::wrong2/, 'wrong2' );
67
68 sub opt ($;_) { is($_[0], "seen"); ok(!defined $_[1], "; has precedence over _") }
69 opt("seen");
70
71 sub unop (_) { is($_[0], 11, "unary op") }
72 unop 11, 22; # takes only the first parameter into account
73
74 sub mymkdir (_;$) { is("@_", $expected, "mymkdir") }
75 $expected = $_ = "mydir"; mymkdir();
76 mymkdir($expected = "foo");
77 $expected = "foo 493"; mymkdir foo => 0755;
78
79 # $_ says modifiable, it's not passed by copy
80
81 sub double(_) { $_[0] *= 2 }
82 $_ = 21;
83 double();
84 is( $_, 42, '$_ is modifiable' );
85 {
86     my $_ = 22;
87     double();
88     is( $_, 44, 'my $_ is modifiable' );
89 }