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"); | |
1c2b4d67 RGS |
17 | is("@$y","y"); |
18 | is("@$x","x"); | |
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"); | |
1c2b4d67 RGS |
25 | is("@$x","a b c x"); |
26 | is("@$y","a b c y"); | |
d8b46c1b GS |
27 | } |
28 | ||
29 | sub new3 { goto &new1 } | |
30 | { | |
31 | my $x = new3("x"); | |
32 | my $y = new3("y"); | |
1c2b4d67 RGS |
33 | is("@$y","y"); |
34 | is("@$x","x"); | |
d8b46c1b GS |
35 | } |
36 | ||
37 | sub new4 { goto &new2 } | |
38 | { | |
39 | my $x = new4("x"); | |
40 | my $y = new4("y"); | |
1c2b4d67 RGS |
41 | is("@$x","a b c x"); |
42 | is("@$y","a b c y"); | |
d8b46c1b | 43 | } |
7032098e GS |
44 | |
45 | # see if POPSUB gets to see the right pad across a dounwind() with | |
46 | # a reified @_ | |
47 | ||
48 | sub methimpl { | |
49 | my $refarg = \@_; | |
50 | die( "got: @_\n" ); | |
51 | } | |
52 | ||
53 | sub method { | |
54 | &methimpl; | |
55 | } | |
56 | ||
57 | sub try { | |
58 | eval { method('foo', 'bar'); }; | |
59 | print "# $@" if $@; | |
60 | } | |
61 | ||
62 | for (1..5) { try() } | |
1c2b4d67 | 63 | pass(); |
51d9a56b | 64 | |
0dae2686 JH |
65 | # bug #21542 local $_[0] causes reify problems and coredumps |
66 | ||
67 | sub local1 { local $_[0] } | |
68 | my $foo = 'foo'; local1($foo); local1($foo); | |
69 | print "got [$foo], expected [foo]\nnot " if $foo ne 'foo'; | |
1c2b4d67 | 70 | pass(); |
0dae2686 JH |
71 | |
72 | sub local2 { local $_[0]; last L } | |
73 | L: { local2 } | |
1c2b4d67 RGS |
74 | pass(); |
75 | ||
76 | # the following test for local(@_) used to be in t/op/nothr5005.t (because it | |
77 | # failed with 5005threads) | |
78 | ||
79 | $|=1; | |
80 | ||
81 | sub foo { local(@_) = ('p', 'q', 'r'); } | |
82 | sub bar { unshift @_, 'D'; @_ } | |
83 | sub baz { push @_, 'E'; return @_ } | |
84 | for (1..3) { | |
85 | is(join('',foo('a', 'b', 'c')),'pqr'); | |
86 | is(join('',bar('d')),'Dd'); | |
87 | is(join('',baz('e')),'eE'); | |
88 | } | |
a6214072 DM |
89 | |
90 | # [perl #28032] delete $_[0] was freeing things too early | |
91 | ||
92 | { | |
93 | my $flag = 0; | |
94 | sub X::DESTROY { $flag = 1 } | |
95 | sub f { | |
96 | delete $_[0]; | |
97 | ok(!$flag, 'delete $_[0] : in f'); | |
98 | } | |
99 | { | |
100 | my $x = bless [], 'X'; | |
101 | f($x); | |
102 | ok(!$flag, 'delete $_[0] : after f'); | |
103 | } | |
104 | ok($flag, 'delete $_[0] : outside block'); | |
105 | } | |
106 | ||
107 |