Commit | Line | Data |
d8b46c1b |
1 | #!./perl |
2 | |
1c2b4d67 |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
6 | } |
7 | |
8 | require './test.pl'; |
a6214072 |
9 | plan( tests => 23 ); |
d8b46c1b |
10 | |
11 | # test various operations on @_ |
12 | |
d8b46c1b |
13 | sub new1 { bless \@_ } |
14 | { |
15 | my $x = new1("x"); |
16 | my $y = new1("y"); |
1c2b4d67 |
17 | is("@$y","y"); |
18 | is("@$x","x"); |
d8b46c1b |
19 | } |
20 | |
21 | sub new2 { splice @_, 0, 0, "a", "b", "c"; return \@_ } |
22 | { |
23 | my $x = new2("x"); |
24 | my $y = new2("y"); |
1c2b4d67 |
25 | is("@$x","a b c x"); |
26 | is("@$y","a b c y"); |
d8b46c1b |
27 | } |
28 | |
29 | sub new3 { goto &new1 } |
30 | { |
31 | my $x = new3("x"); |
32 | my $y = new3("y"); |
1c2b4d67 |
33 | is("@$y","y"); |
34 | is("@$x","x"); |
d8b46c1b |
35 | } |
36 | |
37 | sub new4 { goto &new2 } |
38 | { |
39 | my $x = new4("x"); |
40 | my $y = new4("y"); |
1c2b4d67 |
41 | is("@$x","a b c x"); |
42 | is("@$y","a b c y"); |
d8b46c1b |
43 | } |
7032098e |
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 |
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 |
71 | |
72 | sub local2 { local $_[0]; last L } |
73 | L: { local2 } |
1c2b4d67 |
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 |
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 | |