perl 5.003_07: t/lib/io_pipe.t
[perl.git] / t / op / tie.t
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
8 chdir 't' if -d 't';
9 @INC = "../lib";
10 $ENV{PERL5LIB} = "../lib";
11
12 $|=1;
13
14 undef $/;
15 @prgs = split "\n########\n", <DATA>;
16 print "1..", scalar @prgs, "\n";
17
18 for (@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
38 use Tie::Hash ;
39 tie %h, Tie::StdHash;
40 untie %h;
41 EXPECT
42 ########
43
44 # standard behaviour, with 1 extra reference
45 use Tie::Hash ;
46 $a = tie %h, Tie::StdHash;
47 untie %h;
48 EXPECT
49 ########
50
51 # standard behaviour, with 1 extra reference via tied
52 use Tie::Hash ;
53 tie %h, Tie::StdHash;
54 $a = tied %h;
55 untie %h;
56 EXPECT
57 ########
58
59 # standard behaviour, with 1 extra reference which is destroyed
60 use Tie::Hash ;
61 $a = tie %h, Tie::StdHash;
62 $a = 0 ;
63 untie %h;
64 EXPECT
65 ########
66
67 # standard behaviour, with 1 extra reference via tied which is destroyed
68 use Tie::Hash ;
69 tie %h, Tie::StdHash;
70 $a = tied %h;
71 $a = 0 ;
72 untie %h;
73 EXPECT
74 ########
75
76 # strict behaviour, without any extra references
77 use strict 'untie';
78 use Tie::Hash ;
79 tie %h, Tie::StdHash;
80 untie %h;
81 EXPECT
82 ########
83
84 # strict behaviour, with 1 extra references generating an error
85 use strict 'untie';
86 use Tie::Hash ;
87 $a = tie %h, Tie::StdHash;
88 untie %h;
89 EXPECT
90 Can't untie: 1 inner references still exist at
91 ########
92
93 # strict behaviour, with 1 extra references via tied generating an error
94 use strict 'untie';
95 use Tie::Hash ;
96 tie %h, Tie::StdHash;
97 $a = tied %h;
98 untie %h;
99 EXPECT
100 Can't untie: 1 inner references still exist at
101 ########
102
103 # strict behaviour, with 1 extra references which are destroyed
104 use strict 'untie';
105 use Tie::Hash ;
106 $a = tie %h, Tie::StdHash;
107 $a = 0 ;
108 untie %h;
109 EXPECT
110 ########
111
112 # strict behaviour, with extra 1 references via tied which are destroyed
113 use strict 'untie';
114 use Tie::Hash ;
115 tie %h, Tie::StdHash;
116 $a = tied %h;
117 $a = 0 ;
118 untie %h;
119 EXPECT
120 ########
121
122 # strict error behaviour, with 2 extra references 
123 use strict 'untie';
124 use Tie::Hash ;
125 $a = tie %h, Tie::StdHash;
126 $b = tied %h ;
127 untie %h;
128 EXPECT
129 Can't untie: 2 inner references still exist at
130 ########
131
132 # strict behaviour, check scope of strictness.
133 no strict 'untie';
134 use 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 }
143 untie %H;
144 EXPECT