This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
some WinCE compilers require a little correction
[perl5.git] / t / op / args.t
CommitLineData
d8b46c1b
GS
1#!./perl
2
5dd42e15 3print "1..11\n";
d8b46c1b
GS
4
5# test various operations on @_
6
7my $ord = 0;
8sub 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
20sub 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
32sub 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
44sub 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}
7032098e
GS
55
56# see if POPSUB gets to see the right pad across a dounwind() with
57# a reified @_
58
59sub methimpl {
60 my $refarg = \@_;
61 die( "got: @_\n" );
62}
63
64sub method {
65 &methimpl;
66}
67
68sub try {
69 eval { method('foo', 'bar'); };
70 print "# $@" if $@;
71}
72
73for (1..5) { try() }
74++$ord;
75print "ok $ord\n";
51d9a56b 76
0dae2686
JH
77# bug #21542 local $_[0] causes reify problems and coredumps
78
79sub local1 { local $_[0] }
80my $foo = 'foo'; local1($foo); local1($foo);
81print "got [$foo], expected [foo]\nnot " if $foo ne 'foo';
82$ord++;
83print "ok $ord\n";
84
85sub local2 { local $_[0]; last L }
86L: { local2 }
87$ord++;
88print "ok $ord\n";