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