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