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