3 # This test harness will (eventually) test the "tie" functionality
4 # without the need for a *DBM* implementation.
6 # Currently it only tests use strict "untie".
10 $ENV{PERL5LIB} = "../lib";
15 @prgs = split "\n########\n", <DATA>;
16 print "1..", scalar @prgs, "\n";
19 my($prog,$expected) = split(/\nEXPECT\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";
32 print "ok ", ++$i, "\n";
37 # standard behaviour, without any extra references
44 # standard behaviour, with 1 extra reference
46 $a = tie %h, Tie::StdHash;
51 # standard behaviour, with 1 extra reference via tied
59 # standard behaviour, with 1 extra reference which is destroyed
61 $a = tie %h, Tie::StdHash;
67 # standard behaviour, with 1 extra reference via tied which is destroyed
76 # strict behaviour, without any extra references
84 # strict behaviour, with 1 extra references generating an error
87 $a = tie %h, Tie::StdHash;
90 Can't untie: 1 inner references still exist at
93 # strict behaviour, with 1 extra references via tied generating an error
100 Can't untie: 1 inner references still exist at
103 # strict behaviour, with 1 extra references which are destroyed
106 $a = tie %h, Tie::StdHash;
112 # strict behaviour, with extra 1 references via tied which are destroyed
115 tie %h, Tie::StdHash;
122 # strict error behaviour, with 2 extra references
125 $a = tie %h, Tie::StdHash;
129 Can't untie: 2 inner references still exist at
132 # strict behaviour, check scope of strictness.
135 $A = tie %H, Tie::StdHash;
140 tie %h, Tie::StdHash;