X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F30_already_tied.t;h=f54a27191c9f4910a5873555c79abdd3f1aa17e9;hb=417f635b9e397a107625ab7c71b85548cdf0e32d;hp=cc5e551addc88b69aaea4e688ac99bd0b4b458cb;hpb=fde3db1a5e4879bebec5ca8051caa2804d1a826e;p=dbsrgits%2FDBM-Deep.git diff --git a/t/30_already_tied.t b/t/30_already_tied.t index cc5e551..f54a271 100644 --- a/t/30_already_tied.t +++ b/t/30_already_tied.t @@ -1,75 +1,80 @@ -## -# DBM::Deep Test -## use strict; -use Test::More tests => 7; +use warnings FATAL => 'all'; + +use Test::More; use Test::Exception; -use t::common qw( new_fh ); +use t::common qw( new_dbm ); use_ok( 'DBM::Deep' ); -my ($fh, $filename) = new_fh(); -my $db = DBM::Deep->new( $filename ); +my $dbm_factory = new_dbm(); +while ( my $dbm_maker = $dbm_factory->() ) { + my $db = $dbm_maker->(); -{ { - package My::Tie::Hash; + { + package My::Tie::Hash; - sub TIEHASH { - my $class = shift; + sub TIEHASH { + my $class = shift; - return bless { - }, $class; + return bless { + }, $class; + } } - } - my %hash; - tie %hash, 'My::Tie::Hash'; - isa_ok( tied(%hash), 'My::Tie::Hash' ); + my %hash; + tie %hash, 'My::Tie::Hash'; + isa_ok( tied(%hash), 'My::Tie::Hash' ); - throws_ok { - $db->{foo} = \%hash; - } qr/Cannot store something that is tied/, "Cannot store tied hashes"; -} + throws_ok { + $db->{foo} = \%hash; + } qr/Cannot store something that is tied/, "Cannot store tied hashes"; + } -{ { - package My::Tie::Array; + { + package My::Tie::Array; - sub TIEARRAY { - my $class = shift; + sub TIEARRAY { + my $class = shift; - return bless { - }, $class; - } + return bless { + }, $class; + } - sub FETCHSIZE { 0 } - } + sub FETCHSIZE { 0 } + } - my @array; - tie @array, 'My::Tie::Array'; - isa_ok( tied(@array), 'My::Tie::Array' ); + my @array; + tie @array, 'My::Tie::Array'; + isa_ok( tied(@array), 'My::Tie::Array' ); - throws_ok { - $db->{foo} = \@array; - } qr/Cannot store something that is tied/, "Cannot store tied arrays"; -} + throws_ok { + $db->{foo} = \@array; + } qr/Cannot store something that is tied/, "Cannot store tied arrays"; + } { - package My::Tie::Scalar; + { + package My::Tie::Scalar; - sub TIESCALAR { - my $class = shift; + sub TIESCALAR { + my $class = shift; - return bless { - }, $class; + return bless { + }, $class; + } } - } - my $scalar; - tie $scalar, 'My::Tie::Scalar'; - isa_ok( tied($scalar), 'My::Tie::Scalar' ); + my $scalar; + tie $scalar, 'My::Tie::Scalar'; + isa_ok( tied($scalar), 'My::Tie::Scalar' ); + + throws_ok { + $db->{foo} = \$scalar; + } qr/Storage of references of type 'SCALAR' is not supported/, "Cannot store scalar references, let alone tied scalars"; + } +} -throws_ok { - $db->{foo} = \$scalar; -} qr/Storage of variables of type 'SCALAR' is not supported/, "Cannot store scalar references, let alone tied scalars"; +done_testing;