3 # Add new tests to the end with format:
9 # Warn or die msgs (if any) at - line 1234
14 $ENV{PERL5LIB} = "../lib";
19 @prgs = split /^########\n/m, <DATA>;
22 plan(tests => scalar @prgs);
25 my($prog,$expected) = split(/\nEXPECT\n/, $_, 2);
26 print("not ok $i # bad test format\n"), next
27 unless defined $expected;
28 my ($testname) = $prog =~ /^# (.*)\n/m;
30 $TODO = $testname =~ s/^TODO //;
32 $expected =~ s/\n+$//;
34 fresh_perl_is($prog, $expected, {}, $testname);
39 # standard behaviour, without any extra references
46 # standard behaviour, without any extra references
48 {package Tie::HashUntie;
49 use base 'Tie::StdHash';
55 tie %h, Tie::HashUntie;
61 # standard behaviour, with 1 extra reference
63 $a = tie %h, Tie::StdHash;
68 # standard behaviour, with 1 extra reference via tied
76 # standard behaviour, with 1 extra reference which is destroyed
78 $a = tie %h, Tie::StdHash;
84 # standard behaviour, with 1 extra reference via tied which is destroyed
93 # strict behaviour, without any extra references
101 # strict behaviour, with 1 extra references generating an error
102 use warnings 'untie';
104 $a = tie %h, Tie::StdHash;
107 untie attempted while 1 inner references still exist at - line 6.
110 # strict behaviour, with 1 extra references via tied generating an error
111 use warnings 'untie';
113 tie %h, Tie::StdHash;
117 untie attempted while 1 inner references still exist at - line 7.
120 # strict behaviour, with 1 extra references which are destroyed
121 use warnings 'untie';
123 $a = tie %h, Tie::StdHash;
129 # strict behaviour, with extra 1 references via tied which are destroyed
130 use warnings 'untie';
132 tie %h, Tie::StdHash;
139 # strict error behaviour, with 2 extra references
140 use warnings 'untie';
142 $a = tie %h, Tie::StdHash;
146 untie attempted while 2 inner references still exist at - line 7.
149 # strict behaviour, check scope of strictness.
152 $A = tie %H, Tie::StdHash;
155 use warnings 'untie';
157 tie %h, Tie::StdHash;
164 # Forbidden aggregate self-ties
165 sub Self::TIEHASH { bless $_[1], $_[0] }
171 Self-ties of arrays and hashes are not supported at - line 6.
174 # Allowed scalar self-ties
176 sub Self::TIESCALAR { bless $_[1], $_[0] }
177 sub Self::DESTROY { $destroyed = 1; }
182 die "self-tied scalar not DESTROYed" unless $destroyed == 1;
186 # TODO Allowed glob self-ties
189 sub Self2::TIEHANDLE { bless $_[1], $_[0] }
190 sub Self2::DESTROY { $destroyed = 1; }
191 sub Self2::PRINT { $printed = 1; }
195 tie *$c, 'Self2', $c;
198 die "self-tied glob not PRINTed" unless $printed == 1;
199 die "self-tied glob not DESTROYed" unless $destroyed == 1;
203 # Allowed IO self-ties
205 sub Self3::TIEHANDLE { bless $_[1], $_[0] }
206 sub Self3::DESTROY { $destroyed = 1; }
208 use Symbol 'geniosym';
210 tie *$c, 'Self3', $c;
212 die "self-tied IO not DESTROYed" unless $destroyed == 1;
216 # Interaction of tie and vec
220 tie $a,Tie::StdScalar or die;
229 # correct unlocalisation of tied hashes (patch #16431)
231 tie %tied, Tie::StdHash;
232 { local $hash{'foo'} } warn "plain hash bad unlocalize" if exists $hash{'foo'};
233 { local $tied{'foo'} } warn "tied hash bad unlocalize" if exists $tied{'foo'};
234 { local $ENV{'foo'} } warn "%ENV bad unlocalize" if exists $ENV{'foo'};
238 # An attempt at lvalueable barewords broke this
241 Can't modify constant item in tie at - line 3, near "'main';"
242 Execution of - aborted due to compilation errors.
245 # localizing tied hash slices
248 print exists $ENV{FooA} ? 1 : 0, "\n";
249 print exists $ENV{FooB} ? 2 : 0, "\n";
250 print exists $ENV{FooC} ? 3 : 0, "\n";
252 local @ENV{qw(FooA FooC)};
253 print exists $ENV{FooA} ? 4 : 0, "\n";
254 print exists $ENV{FooB} ? 5 : 0, "\n";
255 print exists $ENV{FooC} ? 6 : 0, "\n";
257 print exists $ENV{FooA} ? 7 : 0, "\n";
258 print exists $ENV{FooB} ? 8 : 0, "\n";
259 print exists $ENV{FooC} ? 9 : 0, "\n"; # this should not exist