Commit | Line | Data |
0e9b1cbd |
1 | |
2 | use strict; |
3 | use warnings; |
4 | use Carp; |
5 | |
6 | my %files = (); |
7 | |
8 | use lib '.'; |
9 | |
10 | { |
11 | chdir 't' if -d 't'; |
12 | if ( ! -d 'DBM_Filter') |
13 | { |
14 | mkdir 'DBM_Filter', 0777 |
15 | || die "Cannot create directory 'DBM_Filter': $!\n" ; |
16 | } |
17 | } |
18 | |
19 | |
20 | sub writeFile |
21 | { |
22 | my $filename = shift ; |
23 | my $content = shift; |
24 | open F, ">DBM_Filter/$filename.pm" || croak "Cannot open $filename: $!" ; |
25 | print F $content ; |
26 | close F; |
27 | $files{"DBM_Filter/$filename.pm"} ++; |
28 | } |
29 | |
30 | END { unlink keys %files if keys %files } |
31 | |
32 | use Test::More tests => 189; |
33 | |
34 | BEGIN { use_ok('DBM_Filter') }; |
35 | BEGIN { use_ok('SDBM_File') }; |
36 | BEGIN { use_ok('Fcntl') }; |
37 | |
38 | unlink <Op_dbmx*>; |
39 | END { unlink <Op_dbmx*>; } |
40 | |
41 | writeFile('times_ten', <<'EOM'); |
42 | package DBM_Filter::times_ten; |
43 | sub Store { $_ *= 10 } |
44 | sub Fetch { $_ /= 10 } |
45 | 1; |
46 | EOM |
47 | |
48 | writeFile('append_A', <<'EOM'); |
49 | package DBM_Filter::append_A; |
50 | sub Store { $_ .= 'A' } |
51 | sub Fetch { s/A$// } |
52 | 1; |
53 | EOM |
54 | |
55 | writeFile('append_B', <<'EOM'); |
56 | package DBM_Filter::append_B; |
57 | sub Store { $_ .= 'B' } |
58 | sub Fetch { s/B$// } |
59 | 1; |
60 | EOM |
61 | |
62 | writeFile('append_C', <<'EOM'); |
63 | package DBM_Filter::append_C; |
64 | sub Store { $_ .= 'C' } |
65 | sub Fetch { s/C$// } |
66 | 1; |
67 | EOM |
68 | |
69 | writeFile('append_D', <<'EOM'); |
70 | package DBM_Filter::append_D; |
71 | sub Store { $_ .= 'D' } |
72 | sub Fetch { s/D$// } |
73 | 1; |
74 | EOM |
75 | |
76 | writeFile('append', <<'EOM'); |
77 | package DBM_Filter::append; |
78 | sub Filter |
79 | { |
80 | my $string = shift ; |
81 | return { |
82 | Store => sub { $_ .= $string }, |
83 | Fetch => sub { s/${string}$// } |
84 | } |
85 | } |
86 | 1; |
87 | EOM |
88 | |
89 | writeFile('double', <<'EOM'); |
90 | package DBM_Filter::double; |
91 | sub Store { $_ *= 2 } |
92 | sub Fetch { $_ /= 2 } |
93 | 1; |
94 | EOM |
95 | |
96 | writeFile('uc', <<'EOM'); |
97 | package DBM_Filter::uc; |
98 | sub Store { $_ = uc $_ } |
99 | sub Fetch { $_ = lc $_ } |
100 | 1; |
101 | EOM |
102 | |
103 | writeFile('reverse', <<'EOM'); |
104 | package DBM_Filter::reverse; |
105 | sub Store { $_ = reverse $_ } |
106 | sub Fetch { $_ = reverse $_ } |
107 | 1; |
108 | EOM |
109 | |
110 | |
111 | my %PreData = ( |
112 | 'abc' => 'def', |
113 | '123' => '456', |
114 | ); |
115 | |
116 | my %PostData = ( |
117 | 'alpha' => 'beta', |
118 | 'green' => 'blue', |
119 | ); |
120 | |
121 | sub doPreData |
122 | { |
123 | my $h = shift ; |
124 | |
125 | $$h{"abc"} = "def"; |
126 | $$h{"123"} = "456"; |
127 | ok $$h{"abc"} eq "def", "read eq written" ; |
128 | ok $$h{"123"} eq "456", "read eq written" ; |
129 | |
130 | } |
131 | |
132 | sub doPostData |
133 | { |
134 | my $h = shift ; |
135 | |
136 | no warnings 'uninitialized'; |
137 | $$h{undef()} = undef(); |
138 | $$h{"alpha"} = "beta"; |
139 | $$h{"green"} = "blue"; |
140 | ok $$h{""} eq "", "read eq written" ; |
141 | ok $$h{"green"} eq "blue", "read eq written" ; |
142 | ok $$h{"green"} eq "blue", "read eq written" ; |
143 | |
144 | } |
145 | |
146 | sub checkRaw |
147 | { |
148 | my $filename = shift ; |
149 | my %expected = @_ ; |
150 | my %h; |
151 | |
152 | # read the dbm file without the filter |
153 | ok tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640), "tied to SDBM_File"; |
154 | |
155 | my %bad = (); |
156 | while (my ($k, $v) = each %h) { |
157 | if ( defined $expected{$k} && $expected{$k} eq $v ) { |
158 | delete $expected{$k} ; |
159 | } |
160 | else |
161 | { $bad{$k} = $v } |
162 | } |
163 | |
164 | ok keys(%expected) + keys(%bad) == 0, "Raw hash is ok"; |
165 | |
166 | if ( keys(%expected) + keys(%bad) ) { |
167 | my $bad = "Expected does not match actual\nExpected:\n" ; |
168 | while (my ($k, $v) = each %expected) { |
169 | $bad .= "\t'$k' =>\t'$v'\n"; |
170 | } |
171 | $bad .= "\nGot:\n" ; |
172 | while (my ($k, $v) = each %bad) { |
173 | $bad .= "\t'$k' =>\t'$v'\n"; |
174 | } |
175 | diag $bad ; |
176 | } |
177 | |
178 | { |
179 | use warnings FATAL => 'untie'; |
180 | eval { untie %h }; |
181 | is $@, '', "untie without inner references" ; |
182 | } |
183 | unlink <Op_dbmx*>; |
184 | } |
185 | |
186 | { |
187 | #diag "Test Set: Key and Value Filter, no stacking, no closure"; |
188 | |
189 | my %h = () ; |
190 | my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; |
191 | ok $db, "tied to SDBM_File"; |
192 | |
193 | doPreData(\%h); |
194 | |
195 | eval { $db->Filter_Push('append_A') }; |
196 | is $@, '', "push 'append_A' filter" ; |
197 | |
198 | doPostData(\%h); |
199 | |
200 | undef $db; |
201 | { |
202 | use warnings FATAL => 'untie'; |
203 | eval { untie %h }; |
204 | is $@, '', "untie without inner references" ; |
205 | } |
206 | |
207 | checkRaw 'Op_dbmx', |
208 | 'abc' => 'def', |
209 | '123' => '456', |
210 | 'A' => 'A', |
211 | 'alphaA' => 'betaA', |
212 | 'greenA' => 'blueA'; |
213 | |
214 | } |
215 | |
216 | { |
217 | #diag "Test Set: Key Only Filter, no stacking, no closure"; |
218 | |
219 | my %h = () ; |
220 | my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; |
221 | ok $db, "tied to SDBM_File"; |
222 | |
223 | doPreData(\%h); |
224 | |
225 | eval { $db->Filter_Key_Push('append_A') }; |
226 | is $@, '', "push 'append_A' filter" ; |
227 | |
228 | doPostData(\%h); |
229 | |
230 | undef $db; |
231 | { |
232 | use warnings FATAL => 'untie'; |
233 | eval { untie %h }; |
234 | is $@, '', "untie without inner references" ; |
235 | } |
236 | |
237 | checkRaw 'Op_dbmx', |
238 | 'abc' => 'def', |
239 | '123' => '456', |
240 | 'A' => '', |
241 | 'alphaA' => 'beta', |
242 | 'greenA' => 'blue'; |
243 | |
244 | } |
245 | |
246 | { |
247 | #diag "Test Set: Value Only Filter, no stacking, no closure"; |
248 | |
249 | my %h = () ; |
250 | my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; |
251 | ok $db, "tied to SDBM_File"; |
252 | |
253 | doPreData(\%h); |
254 | |
255 | eval { $db->Filter_Value_Push('append_A') }; |
256 | is $@, '', "push 'append_A' filter" ; |
257 | |
258 | doPostData(\%h); |
259 | |
260 | undef $db; |
261 | { |
262 | use warnings FATAL => 'untie'; |
263 | eval { untie %h }; |
264 | is $@, '', "untie without inner references" ; |
265 | } |
266 | |
267 | checkRaw 'Op_dbmx', |
268 | 'abc' => 'def', |
269 | '123' => '456', |
270 | '' => 'A', |
271 | 'alpha' => 'betaA', |
272 | 'green' => 'blueA'; |
273 | |
274 | } |
275 | |
276 | { |
277 | #diag "Test Set: Key and Value Filter, with stacking, no closure"; |
278 | |
279 | my %h = () ; |
280 | my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; |
281 | ok $db, "tied to SDBM_File"; |
282 | |
283 | doPreData(\%h); |
284 | |
285 | eval { $db->Filter_Push('append_A') }; |
286 | is $@, '', "push 'append_A' filter" ; |
287 | |
288 | eval { $db->Filter_Push('append_B') }; |
289 | is $@, '', "push 'append_B' filter" ; |
290 | |
291 | doPostData(\%h); |
292 | |
293 | undef $db; |
294 | { |
295 | use warnings FATAL => 'untie'; |
296 | eval { untie %h }; |
297 | is $@, '', "untie without inner references" ; |
298 | } |
299 | |
300 | checkRaw 'Op_dbmx', |
301 | 'abc' => 'def', |
302 | '123' => '456', |
303 | 'AB' => 'AB', |
304 | 'alphaAB' => 'betaAB', |
305 | 'greenAB' => 'blueAB'; |
306 | |
307 | } |
308 | |
309 | { |
310 | #diag "Test Set: Key Filter != Value Filter, with stacking, no closure"; |
311 | |
312 | my %h = () ; |
313 | my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; |
314 | ok $db, "tied to SDBM_File"; |
315 | |
316 | doPreData(\%h); |
317 | |
318 | eval { $db->Filter_Value_Push('append_A') }; |
319 | is $@, '', "push 'append_A' filter" ; |
320 | |
321 | eval { $db->Filter_Key_Push('append_B') }; |
322 | is $@, '', "push 'append_B' filter" ; |
323 | |
324 | eval { $db->Filter_Value_Push('append_C') }; |
325 | is $@, '', "push 'append_C' filter" ; |
326 | |
327 | eval { $db->Filter_Key_Push('append_D') }; |
328 | is $@, '', "push 'append_D' filter" ; |
329 | |
330 | doPostData(\%h); |
331 | |
332 | undef $db; |
333 | { |
334 | use warnings FATAL => 'untie'; |
335 | eval { untie %h }; |
336 | is $@, '', "untie without inner references" ; |
337 | } |
338 | |
339 | checkRaw 'Op_dbmx', |
340 | 'abc' => 'def', |
341 | '123' => '456', |
342 | 'BD' => 'AC', |
343 | 'alphaBD' => 'betaAC', |
344 | 'greenBD' => 'blueAC'; |
345 | |
346 | } |
347 | |
348 | { |
349 | #diag "Test Set: Key only Filter, with stacking, no closure"; |
350 | |
351 | my %h = () ; |
352 | my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; |
353 | ok $db, "tied to SDBM_File"; |
354 | |
355 | doPreData(\%h); |
356 | |
357 | eval { $db->Filter_Key_Push('append_B') }; |
358 | is $@, '', "push 'append_B' filter" ; |
359 | |
360 | eval { $db->Filter_Key_Push('append_D') }; |
361 | is $@, '', "push 'append_D' filter" ; |
362 | |
363 | doPostData(\%h); |
364 | |
365 | undef $db; |
366 | { |
367 | use warnings FATAL => 'untie'; |
368 | eval { untie %h }; |
369 | is $@, '', "untie without inner references" ; |
370 | } |
371 | |
372 | checkRaw 'Op_dbmx', |
373 | 'abc' => 'def', |
374 | '123' => '456', |
375 | 'BD' => '', |
376 | 'alphaBD' => 'beta', |
377 | 'greenBD' => 'blue'; |
378 | |
379 | } |
380 | |
381 | { |
382 | #diag "Test Set: Value only Filter, with stacking, no closure"; |
383 | |
384 | my %h = () ; |
385 | my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; |
386 | ok $db, "tied to SDBM_File"; |
387 | |
388 | doPreData(\%h); |
389 | |
390 | eval { $db->Filter_Value_Push('append_A') }; |
391 | is $@, '', "push 'append_A' filter" ; |
392 | |
393 | eval { $db->Filter_Value_Push('append_C') }; |
394 | is $@, '', "push 'append_C' filter" ; |
395 | |
396 | doPostData(\%h); |
397 | |
398 | undef $db; |
399 | { |
400 | use warnings FATAL => 'untie'; |
401 | eval { untie %h }; |
402 | is $@, '', "untie without inner references" ; |
403 | } |
404 | |
405 | checkRaw 'Op_dbmx', |
406 | 'abc' => 'def', |
407 | '123' => '456', |
408 | '' => 'AC', |
409 | 'alpha' => 'betaAC', |
410 | 'green' => 'blueAC'; |
411 | |
412 | } |
413 | |
414 | { |
415 | #diag "Test Set: Combination Key/Value + Key Filter != Value Filter, with stacking, no closure"; |
416 | |
417 | my %h = () ; |
418 | my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; |
419 | ok $db, "tied to SDBM_File"; |
420 | |
421 | doPreData(\%h); |
422 | |
423 | eval { $db->Filter_Push('append_A') }; |
424 | is $@, '', "push 'append_A' filter" ; |
425 | |
426 | eval { $db->Filter_Value_Push('append_C') }; |
427 | is $@, '', "push 'append_C' filter" ; |
428 | |
429 | eval { $db->Filter_Key_Push('append_D') }; |
430 | is $@, '', "push 'append_D' filter" ; |
431 | |
432 | doPostData(\%h); |
433 | |
434 | undef $db; |
435 | { |
436 | use warnings FATAL => 'untie'; |
437 | eval { untie %h }; |
438 | is $@, '', "untie without inner references" ; |
439 | } |
440 | |
441 | checkRaw 'Op_dbmx', |
442 | 'abc' => 'def', |
443 | '123' => '456', |
444 | 'AD' => 'AC', |
445 | 'alphaAD' => 'betaAC', |
446 | 'greenAD' => 'blueAC'; |
447 | |
448 | } |
449 | |
450 | { |
451 | #diag "Test Set: Combination Key/Value + Key + Key/Value, no closure"; |
452 | |
453 | my %h = () ; |
454 | my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; |
455 | ok $db, "tied to SDBM_File"; |
456 | |
457 | doPreData(\%h); |
458 | |
459 | eval { $db->Filter_Push('append_A') }; |
460 | is $@, '', "push 'append_A' filter" ; |
461 | |
462 | eval { $db->Filter_Key_Push('append_B') }; |
463 | is $@, '', "push 'append_B' filter" ; |
464 | |
465 | eval { $db->Filter_Push('append_C') }; |
466 | is $@, '', "push 'append_C' filter" ; |
467 | |
468 | doPostData(\%h); |
469 | |
470 | undef $db; |
471 | { |
472 | use warnings FATAL => 'untie'; |
473 | eval { untie %h }; |
474 | is $@, '', "untie without inner references" ; |
475 | } |
476 | |
477 | checkRaw 'Op_dbmx', |
478 | 'abc' => 'def', |
479 | '123' => '456', |
480 | 'ABC' => 'AC', |
481 | 'alphaABC' => 'betaAC', |
482 | 'greenABC' => 'blueAC'; |
483 | |
484 | } |
485 | |
486 | { |
487 | #diag "Test Set: Combination Key/Value + Key + Key/Value, with closure"; |
488 | |
489 | my %h = () ; |
490 | my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; |
491 | ok $db, "tied to SDBM_File"; |
492 | |
493 | doPreData(\%h); |
494 | |
495 | eval { $db->Filter_Push('append' => 'A') }; |
496 | is $@, '', "push 'append_A' filter" ; |
497 | |
498 | eval { $db->Filter_Key_Push('append' => 'B') }; |
499 | is $@, '', "push 'append_B' filter" ; |
500 | |
501 | eval { $db->Filter_Push('append' => 'C') }; |
502 | is $@, '', "push 'append_C' filter" ; |
503 | |
504 | doPostData(\%h); |
505 | |
506 | undef $db; |
507 | { |
508 | use warnings FATAL => 'untie'; |
509 | eval { untie %h }; |
510 | is $@, '', "untie without inner references" ; |
511 | } |
512 | |
513 | checkRaw 'Op_dbmx', |
514 | 'abc' => 'def', |
515 | '123' => '456', |
516 | 'ABC' => 'AC', |
517 | 'alphaABC' => 'betaAC', |
518 | 'greenABC' => 'blueAC'; |
519 | |
520 | } |
521 | |
522 | { |
523 | #diag "Test Set: Combination Key/Value + Key + Key/Value, immediate"; |
524 | |
525 | my %h = () ; |
526 | my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; |
527 | ok $db, "tied to SDBM_File"; |
528 | |
529 | doPreData(\%h); |
530 | |
531 | eval { |
532 | $db->Filter_Push( |
533 | Store => sub { $_ .= 'A' }, |
534 | Fetch => sub { s/A$// }) }; |
535 | is $@, '', "push 'append_A' filter" ; |
536 | |
537 | eval { |
538 | $db->Filter_Key_Push( |
539 | Store => sub { $_ .= 'B' }, |
540 | Fetch => sub { s/B$// }) }; |
541 | is $@, '', "push 'append_B' filter" ; |
542 | |
543 | eval { |
544 | $db->Filter_Push( |
545 | Store => sub { $_ .= 'C' }, |
546 | Fetch => sub { s/C$// }) }; |
547 | is $@, '', "push 'append_C' filter" ; |
548 | |
549 | doPostData(\%h); |
550 | |
551 | undef $db; |
552 | { |
553 | use warnings FATAL => 'untie'; |
554 | eval { untie %h }; |
555 | is $@, '', "untie without inner references" ; |
556 | } |
557 | |
558 | checkRaw 'Op_dbmx', |
559 | 'abc' => 'def', |
560 | '123' => '456', |
561 | 'ABC' => 'AC', |
562 | 'alphaABC' => 'betaAC', |
563 | 'greenABC' => 'blueAC'; |
564 | |
565 | } |
566 | |
567 | { |
568 | #diag "Test Set: Combination Key/Value + Key + Key/Value, immediate, closure"; |
569 | |
570 | my %h = () ; |
571 | my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; |
572 | ok $db, "tied to SDBM_File"; |
573 | |
574 | doPreData(\%h); |
575 | |
576 | eval { |
577 | $db->Filter_Push( |
578 | Store => sub { $_ .= 'A' }, |
579 | Fetch => sub { s/A$// }) }; |
580 | is $@, '', "push 'append_A' filter" ; |
581 | |
582 | eval { $db->Filter_Key_Push('append_B') }; |
583 | is $@, '', "push 'append_B' filter" ; |
584 | |
585 | eval { $db->Filter_Push('append' => 'C') }; |
586 | is $@, '', "push 'append_C' filter" ; |
587 | |
588 | doPostData(\%h); |
589 | |
590 | undef $db; |
591 | { |
592 | use warnings FATAL => 'untie'; |
593 | eval { untie %h }; |
594 | is $@, '', "untie without inner references" ; |
595 | } |
596 | |
597 | checkRaw 'Op_dbmx', |
598 | 'abc' => 'def', |
599 | '123' => '456', |
600 | 'ABC' => 'AC', |
601 | 'alphaABC' => 'betaAC', |
602 | 'greenABC' => 'blueAC'; |
603 | |
604 | } |
605 | |
606 | { |
607 | #diag "Test Set: Filtered & Filter_Pop"; |
608 | |
609 | my %h = () ; |
610 | my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; |
611 | ok $db, "tied to SDBM_File"; |
612 | |
613 | doPreData(\%h); |
614 | |
615 | ok ! $db->Filtered, "not filtered" ; |
616 | |
617 | eval { |
618 | $db->Filter_Push( |
619 | Store => sub { $_ .= 'A' }, |
620 | Fetch => sub { s/A$// }) }; |
621 | is $@, '', "push 'append_A' filter" ; |
622 | |
623 | ok $db->Filtered, "is filtered" ; |
624 | |
625 | eval { $db->Filter_Key_Push('append_B') }; |
626 | is $@, '', "push 'append_B' filter" ; |
627 | |
628 | ok $db->Filtered, "is filtered" ; |
629 | |
630 | eval { $db->Filter_Push('append' => 'C') }; |
631 | is $@, '', "push 'append_C' filter" ; |
632 | |
633 | ok $db->Filtered, "is filtered" ; |
634 | |
635 | doPostData(\%h); |
636 | |
637 | eval { $db->Filter_Pop() }; |
638 | is $@, '', "Filter_Pop"; |
639 | |
640 | ok $db->Filtered, "is filtered" ; |
641 | |
642 | $h{'after'} = 'noon'; |
643 | is $h{'after'}, 'noon', "read eq written"; |
644 | |
645 | eval { $db->Filter_Pop() }; |
646 | is $@, '', "Filter_Pop"; |
647 | |
648 | ok $db->Filtered, "is filtered" ; |
649 | |
650 | $h{'morning'} = 'after'; |
651 | is $h{'morning'}, 'after', "read eq written"; |
652 | |
653 | eval { $db->Filter_Pop() }; |
654 | is $@, '', "Filter_Pop"; |
655 | |
656 | ok ! $db->Filtered, "not filtered" ; |
657 | |
658 | $h{'and'} = 'finally'; |
659 | is $h{'and'}, 'finally', "read eq written"; |
660 | |
661 | eval { $db->Filter_Pop() }; |
662 | is $@, '', "Filter_Pop"; |
663 | |
664 | undef $db; |
665 | { |
666 | use warnings FATAL => 'untie'; |
667 | eval { untie %h }; |
668 | is $@, '', "untie without inner references" ; |
669 | } |
670 | |
671 | checkRaw 'Op_dbmx', |
672 | 'abc' => 'def', |
673 | '123' => '456', |
674 | 'ABC' => 'AC', |
675 | 'alphaABC' => 'betaAC', |
676 | 'greenABC' => 'blueAC', |
677 | 'afterAB' => 'noonA', |
678 | 'morningA' => 'afterA', |
679 | 'and' => 'finally'; |
680 | |
681 | } |
682 | |
683 | { |
684 | #diag "Test Set: define the filter package in-line"; |
685 | |
686 | { |
687 | package DBM_Filter::append_X; |
688 | |
689 | sub Store { $_ .= 'X' } |
690 | sub Fetch { s/X$// } |
691 | } |
692 | |
693 | my %h = () ; |
694 | my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; |
695 | ok $db, "tied to SDBM_File"; |
696 | |
697 | doPreData(\%h); |
698 | |
699 | eval { $db->Filter_Push('append_X') }; |
700 | is $@, '', "push 'append_X' filter" ; |
701 | |
702 | doPostData(\%h); |
703 | |
704 | undef $db; |
705 | { |
706 | use warnings FATAL => 'untie'; |
707 | eval { untie %h }; |
708 | is $@, '', "untie without inner references" ; |
709 | } |
710 | |
711 | checkRaw 'Op_dbmx', |
712 | 'abc' => 'def', |
713 | '123' => '456', |
714 | 'X' => 'X', |
715 | 'alphaX' => 'betaX', |
716 | 'greenX' => 'blueX'; |
717 | |
718 | } |
719 | |