Commit | Line | Data |
---|---|---|
93a17b20 | 1 | #!./perl |
8a7eb8fd CK |
2 | BEGIN { |
3 | chdir 't' if -d 't'; | |
4 | @INC = '../lib'; | |
5 | require './test.pl'; | |
6 | } | |
93a17b20 LW |
7 | |
8 | sub foo { | |
9 | my($a, $b) = @_; | |
10 | my $c; | |
11 | my $d; | |
12 | $c = "ok 3\n"; | |
13 | $d = "ok 4\n"; | |
dab48698 SP |
14 | { my($a, undef, $c) = ("ok 9\n", "not ok 10\n", "ok 10\n"); |
15 | ($x, $y) = ($a, $c); } | |
8a7eb8fd CK |
16 | is($a, "ok 1\n", 'value of sub argument maintained outside of block'); |
17 | is($b, "ok 2\n", 'sub argument maintained'); | |
18 | is($c, "ok 3\n", 'variable value maintained outside of block'); | |
19 | is($d, "ok 4\n", 'variable value maintained'); | |
93a17b20 LW |
20 | } |
21 | ||
22 | $a = "ok 5\n"; | |
23 | $b = "ok 6\n"; | |
24 | $c = "ok 7\n"; | |
25 | $d = "ok 8\n"; | |
26 | ||
8a7eb8fd | 27 | &foo("ok 1\n","ok 2\n"); |
93a17b20 | 28 | |
8a7eb8fd CK |
29 | is($a, "ok 5\n", 'global was not affected by duplicate names inside subroutine'); |
30 | is($b, "ok 6\n", '...'); | |
31 | is($c, "ok 7\n", '...'); | |
32 | is($d, "ok 8\n", '...'); | |
33 | is($x, "ok 9\n", 'globals modified inside of block keeps its value outside of block'); | |
34 | is($y, "ok 10\n", '...'); | |
93a17b20 LW |
35 | |
36 | # same thing, only with arrays and associative arrays | |
37 | ||
38 | sub foo2 { | |
39 | my($a, @b) = @_; | |
40 | my(@c, %d); | |
41 | @c = "ok 13\n"; | |
42 | $d{''} = "ok 14\n"; | |
8a7eb8fd CK |
43 | { my($a,@c) = ("ok 19\n", "ok 20\n", "ok 21\n"); ($x, $y) = ($a, @c); } |
44 | is($a, "ok 11\n", 'value of sub argument maintained outside of block'); | |
45 | is(scalar @b, 1, 'did not add any elements to @b'); | |
46 | is($b[0], "ok 12\n", 'did not alter @b'); | |
47 | is(scalar @c, 1, 'did not add arguments to @c'); | |
48 | is($c[0], "ok 13\n", 'did not alter @c'); | |
49 | is($d{''}, "ok 14\n", 'did not touch %d'); | |
93a17b20 LW |
50 | } |
51 | ||
52 | $a = "ok 15\n"; | |
53 | @b = "ok 16\n"; | |
54 | @c = "ok 17\n"; | |
55 | $d{''} = "ok 18\n"; | |
56 | ||
8a7eb8fd | 57 | &foo2("ok 11\n", "ok 12\n"); |
93a17b20 | 58 | |
8a7eb8fd CK |
59 | is($a, "ok 15\n", 'Global was not modifed out of scope'); |
60 | is(scalar @b, 1, 'correct number of elements in array'); | |
61 | is($b[0], "ok 16\n", 'array value was not modified out of scope'); | |
62 | is(scalar @c, 1, 'correct number of elements in array'); | |
63 | is($c[0], "ok 17\n", 'array value was not modified out of scope'); | |
64 | is($d{''}, "ok 18\n", 'hash key/value pair is correct'); | |
65 | is($x, "ok 19\n", 'global was modified'); | |
66 | is($y, "ok 20\n", 'this one too'); | |
a6006777 | 67 | |
68 | my $i = "outer"; | |
69 | ||
70 | if (my $i = "inner") { | |
8a7eb8fd | 71 | is( $i, 'inner', 'my variable inside conditional propagates inside block'); |
a6006777 | 72 | } |
a6006777 | 73 | |
74 | if ((my $i = 1) == 0) { | |
8a7eb8fd | 75 | fail("nested parens do not propagate variable outside"); |
a6006777 | 76 | } |
77 | else { | |
8a7eb8fd | 78 | is($i, 1, 'lexical variable lives available inside else block'); |
a6006777 | 79 | } |
a6006777 | 80 | |
81 | my $j = 5; | |
82 | while (my $i = --$j) { | |
8a7eb8fd | 83 | last unless is( $i, $j, 'lexical inside while block'); |
a6006777 | 84 | } |
85 | continue { | |
8a7eb8fd | 86 | last unless is( $i, $j, 'lexical inside continue block'); |
a6006777 | 87 | } |
8a7eb8fd | 88 | is( $j, 0, 'went through the previous while/continue loop all 4 times' ); |
a6006777 | 89 | |
90 | $j = 5; | |
91 | for (my $i = 0; (my $k = $i) < $j; ++$i) { | |
8a7eb8fd | 92 | fail(""), last unless $i >= 0 && $i < $j && $i == $k; |
a6006777 | 93 | } |
8a7eb8fd | 94 | ok( ! defined $k, '$k is only defined in the scope of the previous for loop' ); |
a6006777 | 95 | |
8a7eb8fd CK |
96 | curr_test(37); |
97 | $jj = 0; | |
98 | foreach my $i (30, 31) { | |
99 | is( $i, $jj+30, 'assignment inside the foreach loop variable definition'); | |
100 | $jj++; | |
a6006777 | 101 | } |
8a7eb8fd | 102 | is( $jj, 2, 'foreach loop executed twice'); |
a6006777 | 103 | |
8a7eb8fd | 104 | is( $i, 'outer', '$i not modified by while/for/foreach using same variable name'); |
cdaebead MB |
105 | |
106 | # Ensure that C<my @y> (without parens) doesn't force scalar context. | |
107 | my @x; | |
108 | { @x = my @y } | |
8a7eb8fd | 109 | is(scalar @x, 0, 'my @y without parens does not force scalar context'); |
cdaebead | 110 | { @x = my %y } |
8a7eb8fd | 111 | is(scalar @x, 0, 'my %y without parens does not force scalar context'); |
cdaebead | 112 | |
6c5b79b0 | 113 | # Found in HTML::FormatPS |
8a7eb8fd | 114 | my %fonts = qw(nok 35); |
6c5b79b0 A |
115 | for my $full (keys %fonts) { |
116 | $full =~ s/^n//; | |
8a7eb8fd | 117 | is( $fonts{nok}, 35, 'Supposed to be copy-on-write via force_normal after a THINKFIRST check.' ); |
6c5b79b0 | 118 | } |
9ff53bc9 DM |
119 | |
120 | # [perl #29340] optimising away the = () left the padav returning the | |
121 | # array rather than the contents, leading to 'Bizarre copy of array' error | |
122 | ||
123 | sub opta { my @a=() } | |
124 | sub opth { my %h=() } | |
125 | eval { my $x = opta }; | |
8a7eb8fd | 126 | is($@, '', ' perl #29340, No bizarre copy of array error'); |
9ff53bc9 | 127 | eval { my $x = opth }; |
8a7eb8fd | 128 | is($@, '', ' perl #29340, No bizarre copy of array error via hash'); |
a62b51b8 SH |
129 | |
130 | sub foo3 { | |
131 | ++my $x->{foo}; | |
8a7eb8fd | 132 | ok(! defined $x->{bar}, '$x->{bar} is not defined'); |
a62b51b8 SH |
133 | ++$x->{bar}; |
134 | } | |
135 | eval { foo3(); foo3(); }; | |
8a7eb8fd | 136 | is( $@, '', 'no errors while checking autovivification and persistence of hash refs inside subs' ); |
a62b51b8 | 137 | |
7c8a3dfd RGS |
138 | # my $foo = undef should always assign [perl #37776] |
139 | { | |
140 | my $count = 35; | |
141 | loop: | |
142 | my $test = undef; | |
8a7eb8fd | 143 | is($test, undef, 'var is undef, repeated test'); |
7c8a3dfd RGS |
144 | $test = 42; |
145 | goto loop if ++$count < 37; | |
146 | } | |
8b8c1fb9 JL |
147 | |
148 | # [perl #113554] | |
149 | eval "my ()"; | |
8a7eb8fd CK |
150 | is( $@, '', "eval of my() passes"); |
151 | ||
f5885b07 DM |
152 | # RT #126844 |
153 | # This triggered a compile-time assert failure in rpeep() | |
154 | eval 'my($a,$b),$x,my($c,$d)'; | |
155 | pass("RT #126844"); | |
156 | ||
8a7eb8fd CK |
157 | #Variable number of tests due to the way the while/for loops are tested now |
158 | done_testing(); |