This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add tests for new strict untie
[perl5.git] / t / op / tie.t
CommitLineData
49d42823
PP
1#!./perl
2
3# This test harness will (eventually) test the "tie" functionality
4# without the need for a *DBM* implementation.
5
6# Currently it only tests use strict "untie".
7
8chdir 't' if -d 't';
9@INC = "../lib";
10$ENV{PERL5LIB} = "../lib";
11
12$|=1;
13
14undef $/;
15@prgs = split "\n########\n", <DATA>;
16print "1..", scalar @prgs, "\n";
17
18for (@prgs){
19 my($prog,$expected) = split(/\nEXPECT\n/, $_);
20 eval "$prog" ;
21 $status = $?;
22 $results = $@ ;
23 $results =~ s/\n+$//;
24 $expected =~ s/\n+$//;
25 if ( $status or $results !~ /^$expected/){
26 print STDERR "STATUS: $status\n";
27 print STDERR "PROG: $prog\n";
28 print STDERR "EXPECTED:\n$expected\n";
29 print STDERR "GOT:\n$results\n";
30 print "not ";
31 }
32 print "ok ", ++$i, "\n";
33}
34
35__END__
36
37# standard behaviour, without any extra references
38use Tie::Hash ;
39tie %h, Tie::StdHash;
40untie %h;
41EXPECT
42########
43
44# standard behaviour, with 1 extra reference
45use Tie::Hash ;
46$a = tie %h, Tie::StdHash;
47untie %h;
48EXPECT
49########
50
51# standard behaviour, with 1 extra reference via tied
52use Tie::Hash ;
53tie %h, Tie::StdHash;
54$a = tied %h;
55untie %h;
56EXPECT
57########
58
59# standard behaviour, with 1 extra reference which is destroyed
60use Tie::Hash ;
61$a = tie %h, Tie::StdHash;
62$a = 0 ;
63untie %h;
64EXPECT
65########
66
67# standard behaviour, with 1 extra reference via tied which is destroyed
68use Tie::Hash ;
69tie %h, Tie::StdHash;
70$a = tied %h;
71$a = 0 ;
72untie %h;
73EXPECT
74########
75
76# strict behaviour, without any extra references
77use strict 'untie';
78use Tie::Hash ;
79tie %h, Tie::StdHash;
80untie %h;
81EXPECT
82########
83
84# strict behaviour, with 1 extra references generating an error
85use strict 'untie';
86use Tie::Hash ;
87$a = tie %h, Tie::StdHash;
88untie %h;
89EXPECT
90Can't untie: 1 inner references still exist at
91########
92
93# strict behaviour, with 1 extra references via tied generating an error
94use strict 'untie';
95use Tie::Hash ;
96tie %h, Tie::StdHash;
97$a = tied %h;
98untie %h;
99EXPECT
100Can't untie: 1 inner references still exist at
101########
102
103# strict behaviour, with 1 extra references which are destroyed
104use strict 'untie';
105use Tie::Hash ;
106$a = tie %h, Tie::StdHash;
107$a = 0 ;
108untie %h;
109EXPECT
110########
111
112# strict behaviour, with extra 1 references via tied which are destroyed
113use strict 'untie';
114use Tie::Hash ;
115tie %h, Tie::StdHash;
116$a = tied %h;
117$a = 0 ;
118untie %h;
119EXPECT
120########
121
122# strict error behaviour, with 2 extra references
123use strict 'untie';
124use Tie::Hash ;
125$a = tie %h, Tie::StdHash;
126$b = tied %h ;
127untie %h;
128EXPECT
129Can't untie: 2 inner references still exist at
130########
131
132# strict behaviour, check scope of strictness.
133no strict 'untie';
134use Tie::Hash ;
135$A = tie %H, Tie::StdHash;
136$C = $B = tied %H ;
137{
138 use strict 'untie';
139 use Tie::Hash ;
140 tie %h, Tie::StdHash;
141 untie %h;
142}
143untie %H;
144EXPECT