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