Commit | Line | Data |
---|---|---|
d8b46c1b GS |
1 | #!./perl |
2 | ||
1c2b4d67 RGS |
3 | BEGIN { |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | } | |
7 | ||
8 | require './test.pl'; | |
a6214072 | 9 | plan( tests => 23 ); |
d8b46c1b GS |
10 | |
11 | # test various operations on @_ | |
12 | ||
d8b46c1b GS |
13 | sub new1 { bless \@_ } |
14 | { | |
15 | my $x = new1("x"); | |
16 | my $y = new1("y"); | |
bae5df40 JK |
17 | is("@$y","y", 'bless'); |
18 | is("@$x","x", 'bless'); | |
d8b46c1b GS |
19 | } |
20 | ||
21 | sub new2 { splice @_, 0, 0, "a", "b", "c"; return \@_ } | |
22 | { | |
23 | my $x = new2("x"); | |
24 | my $y = new2("y"); | |
bae5df40 JK |
25 | is("@$x","a b c x", 'splice'); |
26 | is("@$y","a b c y", 'splice'); | |
d8b46c1b GS |
27 | } |
28 | ||
29 | sub new3 { goto &new1 } | |
30 | { | |
31 | my $x = new3("x"); | |
32 | my $y = new3("y"); | |
bae5df40 JK |
33 | is("@$y","y", 'goto: single element'); |
34 | is("@$x","x", 'goto: single element'); | |
d8b46c1b GS |
35 | } |
36 | ||
37 | sub new4 { goto &new2 } | |
38 | { | |
39 | my $x = new4("x"); | |
40 | my $y = new4("y"); | |
bae5df40 JK |
41 | is("@$x","a b c x", 'goto: multiple elements'); |
42 | is("@$y","a b c y", 'goto: multiple elements'); | |
d8b46c1b | 43 | } |
7032098e | 44 | |
a73d8813 | 45 | # see if cx_popsub() gets to see the right pad across a dounwind() with |
7032098e GS |
46 | # a reified @_ |
47 | ||
48 | sub methimpl { | |
49 | my $refarg = \@_; | |
50 | die( "got: @_\n" ); | |
51 | } | |
52 | ||
53 | sub method { | |
54 | &methimpl; | |
55 | } | |
56 | ||
bae5df40 | 57 | my $failcount = 0; |
7032098e GS |
58 | sub try { |
59 | eval { method('foo', 'bar'); }; | |
60 | print "# $@" if $@; | |
bae5df40 | 61 | $failcount++; |
7032098e GS |
62 | } |
63 | ||
64 | for (1..5) { try() } | |
bae5df40 | 65 | is($failcount, 5, |
a73d8813 | 66 | 'cx_popsub sees right pad across a dounwind() with reified @_'); |
51d9a56b | 67 | |
0dae2686 JH |
68 | # bug #21542 local $_[0] causes reify problems and coredumps |
69 | ||
70 | sub local1 { local $_[0] } | |
71 | my $foo = 'foo'; local1($foo); local1($foo); | |
bae5df40 JK |
72 | is($foo, 'foo', |
73 | "got 'foo' as expected rather than '\$foo': RT \#21542"); | |
0dae2686 JH |
74 | |
75 | sub local2 { local $_[0]; last L } | |
76 | L: { local2 } | |
bae5df40 | 77 | pass("last to label"); |
1c2b4d67 RGS |
78 | |
79 | # the following test for local(@_) used to be in t/op/nothr5005.t (because it | |
80 | # failed with 5005threads) | |
81 | ||
82 | $|=1; | |
83 | ||
84 | sub foo { local(@_) = ('p', 'q', 'r'); } | |
85 | sub bar { unshift @_, 'D'; @_ } | |
86 | sub baz { push @_, 'E'; return @_ } | |
87 | for (1..3) { | |
bae5df40 JK |
88 | is(join('',foo('a', 'b', 'c')),'pqr', 'local @_'); |
89 | is(join('',bar('d')),'Dd', 'unshift @_'); | |
90 | is(join('',baz('e')),'eE', 'push @_'); | |
1c2b4d67 | 91 | } |
a6214072 DM |
92 | |
93 | # [perl #28032] delete $_[0] was freeing things too early | |
94 | ||
95 | { | |
96 | my $flag = 0; | |
97 | sub X::DESTROY { $flag = 1 } | |
98 | sub f { | |
99 | delete $_[0]; | |
100 | ok(!$flag, 'delete $_[0] : in f'); | |
101 | } | |
102 | { | |
103 | my $x = bless [], 'X'; | |
104 | f($x); | |
105 | ok(!$flag, 'delete $_[0] : after f'); | |
106 | } | |
107 | ok($flag, 'delete $_[0] : outside block'); | |
108 | } | |
109 | ||
110 |