Commit | Line | Data |
---|---|---|
b13fd70a RGS |
1 | #!perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | require "./test.pl"; | |
7 | } | |
8 | ||
3cd0a11a | 9 | plan(tests => 39); |
b13fd70a RGS |
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 | ||
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 |
51 | sub g(_) { is(shift, $expected) } |
52 | ||
53 | $expected = "foo"; | |
54 | g("foo"); | |
55 | g($expected); | |
56 | $_ = $expected; | |
57 | g(); | |
3cd0a11a | 58 | g; |
236b555a RGS |
59 | undef $expected; &g; # $_ not passed |
60 | { $expected = my $_ = "bar"; g() } | |
f00d1d61 RGS |
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' ); | |
5df4b323 RGS |
67 | |
68 | sub opt ($;_) { is($_[0], "seen"); ok(!defined $_[1], "; has precedence over _") } | |
69 | opt("seen"); | |
bfd79223 | 70 | |
cb40c25d | 71 | sub unop (_) { is($_[0], 11, "unary op") } |
bfd79223 | 72 | unop 11, 22; # takes only the first parameter into account |
cb40c25d RGS |
73 | |
74 | sub mymkdir (_;$) { is("@_", $expected, "mymkdir") } | |
75 | $expected = $_ = "mydir"; mymkdir(); | |
76 | mymkdir($expected = "foo"); | |
77 | $expected = "foo 493"; mymkdir foo => 0755; | |
6a8363ef RGS |
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 | } |