This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: not OK, 6919 on Alpha VMS V 7.1 w/ DECC 6.0-001
[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';
20822f61 9@INC = '../lib';
49d42823
PP
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
4438c4b7 80use warnings 'untie';
49d42823
PP
81use Tie::Hash ;
82tie %h, Tie::StdHash;
83untie %h;
84EXPECT
85########
86
87# strict behaviour, with 1 extra references generating an error
4438c4b7 88use warnings 'untie';
49d42823
PP
89use Tie::Hash ;
90$a = tie %h, Tie::StdHash;
91untie %h;
92EXPECT
55497cff 93untie attempted while 1 inner references still exist
49d42823
PP
94########
95
96# strict behaviour, with 1 extra references via tied generating an error
4438c4b7 97use warnings 'untie';
49d42823
PP
98use Tie::Hash ;
99tie %h, Tie::StdHash;
100$a = tied %h;
101untie %h;
102EXPECT
55497cff 103untie attempted while 1 inner references still exist
49d42823
PP
104########
105
106# strict behaviour, with 1 extra references which are destroyed
4438c4b7 107use warnings 'untie';
49d42823
PP
108use Tie::Hash ;
109$a = tie %h, Tie::StdHash;
110$a = 0 ;
111untie %h;
112EXPECT
113########
114
115# strict behaviour, with extra 1 references via tied which are destroyed
4438c4b7 116use warnings 'untie';
49d42823
PP
117use Tie::Hash ;
118tie %h, Tie::StdHash;
119$a = tied %h;
120$a = 0 ;
121untie %h;
122EXPECT
123########
124
125# strict error behaviour, with 2 extra references
4438c4b7 126use warnings 'untie';
49d42823
PP
127use Tie::Hash ;
128$a = tie %h, Tie::StdHash;
129$b = tied %h ;
130untie %h;
131EXPECT
55497cff 132untie attempted while 2 inner references still exist
49d42823
PP
133########
134
135# strict behaviour, check scope of strictness.
4438c4b7 136no warnings 'untie';
49d42823
PP
137use Tie::Hash ;
138$A = tie %H, Tie::StdHash;
139$C = $B = tied %H ;
140{
4438c4b7 141 use warnings 'untie';
49d42823
PP
142 use Tie::Hash ;
143 tie %h, Tie::StdHash;
144 untie %h;
145}
146untie %H;
147EXPECT
33c27489
GS
148########
149
150# verify no leak when underlying object is selfsame tied variable
151my ($a, $b);
152sub Self::TIEHASH { bless $_[1], $_[0] }
153sub Self::DESTROY { $b = $_[0] + 0; }
154{
155 my %b5;
156 $a = \%b5 + 0;
157 tie %b5, 'Self', \%b5;
158}
159die unless $a == $b;
160EXPECT
7bb043c3
IP
161########
162# Interaction of tie and vec
163
164my ($a, $b);
165use Tie::Scalar;
166tie $a,Tie::StdScalar or die;
167vec($b,1,1)=1;
168$a = $b;
169vec($a,1,1)=0;
170vec($b,1,1)=0;
171die unless $a eq $b;
172EXPECT