Commit | Line | Data |
d8b46c1b |
1 | #!./perl |
2 | |
51d9a56b |
3 | print "1..11\n"; |
d8b46c1b |
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 | } |
7032098e |
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"; |
51d9a56b |
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"; |