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 }