diff options
author | Perl 5 Porters <perl5-porters@africa.nicoh.com> | 1996-07-03 20:10:46 +0000 |
---|---|---|
committer | Charles Bailey <bailey@genetics.upenn.edu> | 1996-07-03 20:10:46 +0000 |
commit | 49d42823aebe110c9951956039be0e2cd0dde978 (patch) | |
tree | 3f354a02e5b942851f0fa13edebe8243d484835f | |
parent | 85fe63caf06a70056068c4de1c5c2c10de59ea84 (diff) | |
download | perl-49d42823aebe110c9951956039be0e2cd0dde978.tar.gz |
Add tests for new strict untie
-rw-r--r-- | t/op/tie.t | 144 |
1 files changed, 144 insertions, 0 deletions
diff --git a/t/op/tie.t b/t/op/tie.t new file mode 100644 index 0000000000..cf116519e6 --- /dev/null +++ b/t/op/tie.t @@ -0,0 +1,144 @@ +#!./perl + +# This test harness will (eventually) test the "tie" functionality +# without the need for a *DBM* implementation. + +# Currently it only tests use strict "untie". + +chdir 't' if -d 't'; +@INC = "../lib"; +$ENV{PERL5LIB} = "../lib"; + +$|=1; + +undef $/; +@prgs = split "\n########\n", <DATA>; +print "1..", scalar @prgs, "\n"; + +for (@prgs){ + my($prog,$expected) = split(/\nEXPECT\n/, $_); + eval "$prog" ; + $status = $?; + $results = $@ ; + $results =~ s/\n+$//; + $expected =~ s/\n+$//; + if ( $status or $results !~ /^$expected/){ + print STDERR "STATUS: $status\n"; + print STDERR "PROG: $prog\n"; + print STDERR "EXPECTED:\n$expected\n"; + print STDERR "GOT:\n$results\n"; + print "not "; + } + print "ok ", ++$i, "\n"; +} + +__END__ + +# standard behaviour, without any extra references +use Tie::Hash ; +tie %h, Tie::StdHash; +untie %h; +EXPECT +######## + +# standard behaviour, with 1 extra reference +use Tie::Hash ; +$a = tie %h, Tie::StdHash; +untie %h; +EXPECT +######## + +# standard behaviour, with 1 extra reference via tied +use Tie::Hash ; +tie %h, Tie::StdHash; +$a = tied %h; +untie %h; +EXPECT +######## + +# standard behaviour, with 1 extra reference which is destroyed +use Tie::Hash ; +$a = tie %h, Tie::StdHash; +$a = 0 ; +untie %h; +EXPECT +######## + +# standard behaviour, with 1 extra reference via tied which is destroyed +use Tie::Hash ; +tie %h, Tie::StdHash; +$a = tied %h; +$a = 0 ; +untie %h; +EXPECT +######## + +# strict behaviour, without any extra references +use strict 'untie'; +use Tie::Hash ; +tie %h, Tie::StdHash; +untie %h; +EXPECT +######## + +# strict behaviour, with 1 extra references generating an error +use strict 'untie'; +use Tie::Hash ; +$a = tie %h, Tie::StdHash; +untie %h; +EXPECT +Can't untie: 1 inner references still exist at +######## + +# strict behaviour, with 1 extra references via tied generating an error +use strict 'untie'; +use Tie::Hash ; +tie %h, Tie::StdHash; +$a = tied %h; +untie %h; +EXPECT +Can't untie: 1 inner references still exist at +######## + +# strict behaviour, with 1 extra references which are destroyed +use strict 'untie'; +use Tie::Hash ; +$a = tie %h, Tie::StdHash; +$a = 0 ; +untie %h; +EXPECT +######## + +# strict behaviour, with extra 1 references via tied which are destroyed +use strict 'untie'; +use Tie::Hash ; +tie %h, Tie::StdHash; +$a = tied %h; +$a = 0 ; +untie %h; +EXPECT +######## + +# strict error behaviour, with 2 extra references +use strict 'untie'; +use Tie::Hash ; +$a = tie %h, Tie::StdHash; +$b = tied %h ; +untie %h; +EXPECT +Can't untie: 2 inner references still exist at +######## + +# strict behaviour, check scope of strictness. +no strict 'untie'; +use Tie::Hash ; +$A = tie %H, Tie::StdHash; +$C = $B = tied %H ; +{ + use strict 'untie'; + use Tie::Hash ; + tie %h, Tie::StdHash; + untie %h; +} +untie %H; +EXPECT |