Commit | Line | Data |
49d42823 |
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 |
7 | |
8 | chdir 't' if -d 't'; |
9 | @INC = "../lib"; |
10 | $ENV{PERL5LIB} = "../lib"; |
11 | |
12 | $|=1; |
13 | |
55497cff |
14 | # catch warnings into fatal errors |
15 | $SIG{__WARN__} = sub { die "WARNING: @_" } ; |
16 | |
49d42823 |
17 | undef $/; |
18 | @prgs = split "\n########\n", <DATA>; |
19 | print "1..", scalar @prgs, "\n"; |
20 | |
21 | for (@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 |
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 |
41 | use Tie::Hash ; |
42 | tie %h, Tie::StdHash; |
43 | untie %h; |
44 | EXPECT |
45 | ######## |
46 | |
47 | # standard behaviour, with 1 extra reference |
48 | use Tie::Hash ; |
49 | $a = tie %h, Tie::StdHash; |
50 | untie %h; |
51 | EXPECT |
52 | ######## |
53 | |
54 | # standard behaviour, with 1 extra reference via tied |
55 | use Tie::Hash ; |
56 | tie %h, Tie::StdHash; |
57 | $a = tied %h; |
58 | untie %h; |
59 | EXPECT |
60 | ######## |
61 | |
62 | # standard behaviour, with 1 extra reference which is destroyed |
63 | use Tie::Hash ; |
64 | $a = tie %h, Tie::StdHash; |
65 | $a = 0 ; |
66 | untie %h; |
67 | EXPECT |
68 | ######## |
69 | |
70 | # standard behaviour, with 1 extra reference via tied which is destroyed |
71 | use Tie::Hash ; |
72 | tie %h, Tie::StdHash; |
73 | $a = tied %h; |
74 | $a = 0 ; |
75 | untie %h; |
76 | EXPECT |
77 | ######## |
78 | |
79 | # strict behaviour, without any extra references |
599cee73 |
80 | use warning 'untie'; |
81 | #local $^W = 1 ; |
49d42823 |
82 | use Tie::Hash ; |
83 | tie %h, Tie::StdHash; |
84 | untie %h; |
85 | EXPECT |
86 | ######## |
87 | |
88 | # strict behaviour, with 1 extra references generating an error |
599cee73 |
89 | use warning 'untie'; |
90 | #local $^W = 1 ; |
49d42823 |
91 | use Tie::Hash ; |
92 | $a = tie %h, Tie::StdHash; |
93 | untie %h; |
94 | EXPECT |
55497cff |
95 | untie attempted while 1 inner references still exist |
49d42823 |
96 | ######## |
97 | |
98 | # strict behaviour, with 1 extra references via tied generating an error |
599cee73 |
99 | use warning 'untie'; |
100 | #local $^W = 1 ; |
49d42823 |
101 | use Tie::Hash ; |
102 | tie %h, Tie::StdHash; |
103 | $a = tied %h; |
104 | untie %h; |
105 | EXPECT |
55497cff |
106 | untie attempted while 1 inner references still exist |
49d42823 |
107 | ######## |
108 | |
109 | # strict behaviour, with 1 extra references which are destroyed |
599cee73 |
110 | use warning 'untie'; |
111 | #local $^W = 1 ; |
49d42823 |
112 | use Tie::Hash ; |
113 | $a = tie %h, Tie::StdHash; |
114 | $a = 0 ; |
115 | untie %h; |
116 | EXPECT |
117 | ######## |
118 | |
119 | # strict behaviour, with extra 1 references via tied which are destroyed |
599cee73 |
120 | use warning 'untie'; |
121 | #local $^W = 1 ; |
49d42823 |
122 | use Tie::Hash ; |
123 | tie %h, Tie::StdHash; |
124 | $a = tied %h; |
125 | $a = 0 ; |
126 | untie %h; |
127 | EXPECT |
128 | ######## |
129 | |
130 | # strict error behaviour, with 2 extra references |
599cee73 |
131 | use warning 'untie'; |
132 | #local $^W = 1 ; |
49d42823 |
133 | use Tie::Hash ; |
134 | $a = tie %h, Tie::StdHash; |
135 | $b = tied %h ; |
136 | untie %h; |
137 | EXPECT |
55497cff |
138 | untie attempted while 2 inner references still exist |
49d42823 |
139 | ######## |
140 | |
141 | # strict behaviour, check scope of strictness. |
599cee73 |
142 | no warning 'untie'; |
143 | #local $^W = 0 ; |
49d42823 |
144 | use Tie::Hash ; |
145 | $A = tie %H, Tie::StdHash; |
146 | $C = $B = tied %H ; |
147 | { |
599cee73 |
148 | use warning 'untie'; |
149 | #local $^W = 1 ; |
49d42823 |
150 | use Tie::Hash ; |
151 | tie %h, Tie::StdHash; |
152 | untie %h; |
153 | } |
154 | untie %H; |
155 | EXPECT |