Commit | Line | Data |
a687059c |
1 | #!./perl |
2 | |
79072805 |
3 | # $RCSfile: local.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:04 $ |
a687059c |
4 | |
4e4c362e |
5 | print "1..47\n"; |
a687059c |
6 | |
7 | sub foo { |
8 | local($a, $b) = @_; |
9 | local($c, $d); |
10 | $c = "ok 3\n"; |
11 | $d = "ok 4\n"; |
12 | { local($a,$c) = ("ok 9\n", "ok 10\n"); ($x, $y) = ($a, $c); } |
13 | print $a, $b; |
14 | $c . $d; |
15 | } |
16 | |
17 | $a = "ok 5\n"; |
18 | $b = "ok 6\n"; |
19 | $c = "ok 7\n"; |
20 | $d = "ok 8\n"; |
21 | |
93a17b20 |
22 | print &foo("ok 1\n","ok 2\n"); |
a687059c |
23 | |
24 | print $a,$b,$c,$d,$x,$y; |
25 | |
26 | # same thing, only with arrays and associative arrays |
27 | |
28 | sub foo2 { |
29 | local($a, @b) = @_; |
30 | local(@c, %d); |
31 | @c = "ok 13\n"; |
32 | $d{''} = "ok 14\n"; |
33 | { local($a,@c) = ("ok 19\n", "ok 20\n"); ($x, $y) = ($a, @c); } |
34 | print $a, @b; |
35 | $c[0] . $d{''}; |
36 | } |
37 | |
38 | $a = "ok 15\n"; |
39 | @b = "ok 16\n"; |
40 | @c = "ok 17\n"; |
41 | $d{''} = "ok 18\n"; |
42 | |
93a17b20 |
43 | print &foo2("ok 11\n","ok 12\n"); |
a687059c |
44 | |
45 | print $a,@b,@c,%d,$x,$y; |
706a304b |
46 | |
47 | eval 'local($$e)'; |
48 | print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 21\n"; |
49 | |
50 | eval 'local(@$e)'; |
51 | print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 22\n"; |
52 | |
53 | eval 'local(%$e)'; |
54 | print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 23\n"; |
85aff577 |
55 | |
161b7d16 |
56 | # Array and hash elements |
57 | |
58 | @a = ('a', 'b', 'c'); |
59 | { |
60 | local($a[1]) = 'foo'; |
61 | local($a[2]) = $a[2]; |
2bb40b7f |
62 | print +($a[1] eq 'foo') ? "" : "not ", "ok 24\n"; |
63 | print +($a[2] eq 'c') ? "" : "not ", "ok 25\n"; |
161b7d16 |
64 | undef @a; |
65 | } |
2bb40b7f |
66 | print +($a[1] eq 'b') ? "" : "not ", "ok 26\n"; |
67 | print +($a[2] eq 'c') ? "" : "not ", "ok 27\n"; |
68 | print +(!defined $a[0]) ? "" : "not ", "ok 28\n"; |
161b7d16 |
69 | |
70 | @a = ('a', 'b', 'c'); |
71 | { |
72 | local($a[1]) = "X"; |
73 | shift @a; |
74 | } |
2bb40b7f |
75 | print +($a[0].$a[1] eq "Xb") ? "" : "not ", "ok 29\n"; |
161b7d16 |
76 | |
77 | %h = ('a' => 1, 'b' => 2, 'c' => 3); |
78 | { |
79 | local($h{'a'}) = 'foo'; |
80 | local($h{'b'}) = $h{'b'}; |
2bb40b7f |
81 | print +($h{'a'} eq 'foo') ? "" : "not ", "ok 30\n"; |
82 | print +($h{'b'} == 2) ? "" : "not ", "ok 31\n"; |
161b7d16 |
83 | local($h{'c'}); |
84 | delete $h{'c'}; |
85 | } |
2bb40b7f |
86 | print +($h{'a'} == 1) ? "" : "not ", "ok 32\n"; |
87 | print +($h{'b'} == 2) ? "" : "not ", "ok 33\n"; |
88 | print +($h{'c'} == 3) ? "" : "not ", "ok 34\n"; |
89 | |
90 | # check for scope leakage |
91 | $a = 'outer'; |
92 | if (1) { local $a = 'inner' } |
93 | print +($a eq 'outer') ? "" : "not ", "ok 35\n"; |
94 | |
95 | # see if localization works when scope unwinds |
96 | local $m = 5; |
97 | eval { |
98 | for $m (6) { |
99 | local $m = 7; |
100 | die "bye"; |
101 | } |
102 | }; |
103 | print $m == 5 ? "" : "not ", "ok 36\n"; |
4e4c362e |
104 | |
105 | # see if localization works on tied arrays |
106 | { |
107 | package TA; |
108 | sub TIEARRAY { bless [], $_[0] } |
109 | sub STORE { print "# STORE [@_]\n"; $_[0]->[$_[1]] = $_[2] } |
110 | sub FETCH { my $v = $_[0]->[$_[1]]; print "# FETCH [@_=$v]\n"; $v } |
111 | sub CLEAR { print "# CLEAR [@_]\n"; @{$_[0]} = (); } |
112 | sub FETCHSIZE { scalar(@{$_[0]}) } |
113 | sub SHIFT { shift (@{$_[0]}) } |
114 | sub EXTEND {} |
115 | } |
116 | |
117 | tie @a, 'TA'; |
118 | @a = ('a', 'b', 'c'); |
119 | { |
120 | local($a[1]) = 'foo'; |
121 | local($a[2]) = $a[1]; # XXX LHS == RHS doesn't work yet |
122 | print +($a[1] eq 'foo') ? "" : "not ", "ok 37\n"; |
123 | print +($a[2] eq 'foo') ? "" : "not ", "ok 38\n"; |
124 | @a = (); |
125 | } |
126 | print +($a[1] eq 'b') ? "" : "not ", "ok 39\n"; |
127 | print +($a[2] eq 'c') ? "" : "not ", "ok 40\n"; |
128 | print +(!defined $a[0]) ? "" : "not ", "ok 41\n"; |
129 | |
130 | { |
131 | package TH; |
132 | sub TIEHASH { bless {}, $_[0] } |
133 | sub STORE { print "# STORE [@_]\n"; $_[0]->{$_[1]} = $_[2] } |
134 | sub FETCH { my $v = $_[0]->{$_[1]}; print "# FETCH [@_=$v]\n"; $v } |
135 | sub DELETE { print "# DELETE [@_]\n"; delete $_[0]->{$_[1]}; } |
136 | sub CLEAR { print "# CLEAR [@_]\n"; %{$_[0]} = (); } |
137 | } |
138 | |
139 | # see if localization works on tied hashes |
140 | tie %h, 'TH'; |
141 | %h = ('a' => 1, 'b' => 2, 'c' => 3); |
142 | |
143 | { |
144 | local($h{'a'}) = 'foo'; |
145 | local($h{'b'}) = $h{'a'}; # XXX LHS == RHS doesn't work yet |
146 | print +($h{'a'} eq 'foo') ? "" : "not ", "ok 42\n"; |
147 | print +($h{'b'} eq 'foo') ? "" : "not ", "ok 43\n"; |
148 | local($h{'c'}); |
149 | delete $h{'c'}; |
150 | } |
151 | print +($h{'a'} == 1) ? "" : "not ", "ok 44\n"; |
152 | print +($h{'b'} == 2) ? "" : "not ", "ok 45\n"; |
153 | print +($h{'c'} == 3) ? "" : "not ", "ok 46\n"; |
154 | |
155 | @a = ('a', 'b', 'c'); |
156 | { |
157 | local($a[1]) = "X"; |
158 | shift @a; |
159 | } |
160 | print +($a[0].$a[1] eq "Xb") ? "" : "not ", "ok 47\n"; |
161 | |