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;
31 $expected =~ s/\n+$//;
33 fresh_perl_is($prog, $expected, {}, $testname);
38 # standard behaviour, without any extra references
45 # standard behaviour, without any extra references
47 {package Tie::HashUntie;
48 use base 'Tie::StdHash';
54 tie %h, Tie::HashUntie;
60 # standard behaviour, with 1 extra reference
62 $a = tie %h, Tie::StdHash;
67 # standard behaviour, with 1 extra reference via tied
75 # standard behaviour, with 1 extra reference which is destroyed
77 $a = tie %h, Tie::StdHash;
83 # standard behaviour, with 1 extra reference via tied which is destroyed
92 # strict behaviour, without any extra references
100 # strict behaviour, with 1 extra references generating an error
101 use warnings 'untie';
103 $a = tie %h, Tie::StdHash;
106 untie attempted while 1 inner references still exist at - line 6.
109 # strict behaviour, with 1 extra references via tied generating an error
110 use warnings 'untie';
112 tie %h, Tie::StdHash;
116 untie attempted while 1 inner references still exist at - line 7.
119 # strict behaviour, with 1 extra references which are destroyed
120 use warnings 'untie';
122 $a = tie %h, Tie::StdHash;
128 # strict behaviour, with extra 1 references via tied which are destroyed
129 use warnings 'untie';
131 tie %h, Tie::StdHash;
138 # strict error behaviour, with 2 extra references
139 use warnings 'untie';
141 $a = tie %h, Tie::StdHash;
145 untie attempted while 2 inner references still exist at - line 7.
148 # strict behaviour, check scope of strictness.
151 $A = tie %H, Tie::StdHash;
154 use warnings 'untie';
156 tie %h, Tie::StdHash;
163 # Forbidden aggregate self-ties
164 sub Self::TIEHASH { bless $_[1], $_[0] }
170 Self-ties of arrays and hashes are not supported at - line 6.
173 # Allowed scalar self-ties
175 sub Self::TIESCALAR { bless $_[1], $_[0] }
176 sub Self::DESTROY { $destroyed = 1; }
181 die "self-tied scalar not DESTROYd" unless $destroyed == 1;
185 # Allowed glob self-ties
188 sub Self2::TIEHANDLE { bless $_[1], $_[0] }
189 sub Self2::DESTROY { $destroyed = 1; }
190 sub Self2::PRINT { $printed = 1; }
194 tie *$c, 'Self2', $c;
197 die "self-tied glob not PRINTed" unless $printed == 1;
198 die "self-tied glob not DESTROYd" unless $destroyed == 1;
202 # Allowed IO self-ties
204 sub Self3::TIEHANDLE { bless $_[1], $_[0] }
205 sub Self3::DESTROY { $destroyed = 1; }
207 use Symbol 'geniosym';
209 tie *$c, 'Self3', $c;
211 die "self-tied IO not DESTROYd" unless $destroyed == 1;
215 # Interaction of tie and vec
219 tie $a,Tie::StdScalar or die;
228 # correct unlocalisation of tied hashes (patch #16431)
230 tie %tied, Tie::StdHash;
231 { local $hash{'foo'} } warn "plain hash bad unlocalize" if exists $hash{'foo'};
232 { local $tied{'foo'} } warn "tied hash bad unlocalize" if exists $tied{'foo'};
233 { local $ENV{'foo'} } warn "%ENV bad unlocalize" if exists $ENV{'foo'};
237 # An attempt at lvalueable barewords broke this
240 Can't modify constant item in tie at - line 3, near "'main';"
241 Execution of - aborted due to compilation errors.