t/op/args.t

   1 #!./perl
   2
   3 print "1..11\n";
   4
   5 # test various operations on @_
   6
   7 my $ord = 0;
   8 sub new1 { bless \@_ }
   9 {
  10     my $x = new1("x");
  11     my $y = new1("y");
  12     ++$ord;
  13     print "# got [@$y], expected [y]\nnot " unless "@$y" eq "y";
  14     print "ok $ord\n";
  15     ++$ord;
  16     print "# got [@$x], expected [x]\nnot " unless "@$x" eq "x";
  17     print "ok $ord\n";
  18 }
  19
  20 sub new2 { splice @_, 0, 0, "a", "b", "c"; return \@_ }
  21 {
  22     my $x = new2("x");
  23     my $y = new2("y");
  24     ++$ord;
  25     print "# got [@$x], expected [a b c x]\nnot " unless "@$x" eq "a b c x";
  26     print "ok $ord\n";
  27     ++$ord;
  28     print "# got [@$y], expected [a b c y]\nnot " unless "@$y" eq "a b c y";
  29     print "ok $ord\n";
  30 }
  31
  32 sub new3 { goto &new1 }
  33 {
  34     my $x = new3("x");
  35     my $y = new3("y");
  36     ++$ord;
  37     print "# got [@$y], expected [y]\nnot " unless "@$y" eq "y";
  38     print "ok $ord\n";
  39     ++$ord;
  40     print "# got [@$x], expected [x]\nnot " unless "@$x" eq "x";
  41     print "ok $ord\n";
  42 }
  43
  44 sub new4 { goto &new2 }
  45 {
  46     my $x = new4("x");
  47     my $y = new4("y");
  48     ++$ord;
  49     print "# got [@$x], expected [a b c x]\nnot " unless "@$x" eq "a b c x";
  50     print "ok $ord\n";
  51     ++$ord;
  52     print "# got [@$y], expected [a b c y]\nnot " unless "@$y" eq "a b c y";
  53     print "ok $ord\n";
  54 }
  55
  56 # see if POPSUB gets to see the right pad across a dounwind() with
  57 # a reified @_
  58
  59 sub methimpl {
  60     my $refarg = \@_;
  61     die( "got: @_\n" );
  62 }
  63
  64 sub method {
  65     &methimpl;
  66 }
  67
  68 sub try {
  69     eval { method('foo', 'bar'); };
  70     print "# $@" if $@;
  71 }
  72
  73 for (1..5) { try() }
  74 ++$ord;
  75 print "ok $ord\n";
  76
  77 # bug #21542 local $_[0] causes reify problems and coredumps
  78
  79 sub local1 { local $_[0] }
  80 my $foo = 'foo'; local1($foo); local1($foo);
  81 print "got [$foo], expected [foo]\nnot " if $foo ne 'foo';
  82 $ord++;
  83 print "ok $ord\n";
  84
  85 sub local2 { local $_[0]; last L }
  86 L: { local2 }
  87 $ord++;
  88 print "ok $ord\n";