X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F26_scalar_ref.t;h=ab6ace73e9a6a24c53cf90f423df2b5f8b9f480b;hb=67e9b86f22e8dacf29904f0163be3b23fae91074;hp=405c6fe6919343d5b73c8b379333cad2f082337a;hpb=2a81bf9ee4b16d5e7e4f1e267b74cd0b79fa13a9;p=dbsrgits%2FDBM-Deep.git diff --git a/t/26_scalar_ref.t b/t/26_scalar_ref.t index 405c6fe..ab6ace7 100644 --- a/t/26_scalar_ref.t +++ b/t/26_scalar_ref.t @@ -1,39 +1,60 @@ use strict; +use warnings FATAL => 'all'; -use Test::More tests => 7; -use File::Temp qw( tempfile tempdir ); +use Test::More; +use Test::Exception; +use t::common qw( new_dbm new_fh ); use_ok( 'DBM::Deep' ); -my $dir = tempdir( CLEANUP => 1 ); -my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir ); - -{ - my $db = DBM::Deep->new( $filename ); - - my $x = 25; - my $y = 30; - $db->{scalar} = $x; - $db->{scalarref} = \$y; - $db->{selfref} = \$x; - - is( $db->{scalar}, $x, "Scalar retrieved ok" ); - TODO: { - todo_skip "Scalar refs aren't implemented yet", 2; - is( ${$db->{scalarref}}, 30, "Scalarref retrieved ok" ); - is( ${$db->{selfref}}, 25, "Scalarref to stored scalar retrieved ok" ); +my $x = 25; +my $dbm_factory = new_dbm(); +while ( my $dbm_maker = $dbm_factory->() ) { + { + my $db = $dbm_maker->(); + + throws_ok { + $db->{scalarref} = \$x; + } qr/Storage of references of type 'SCALAR' is not supported/, + 'Storage of scalar refs not supported'; + + throws_ok { + $db->{scalarref} = \\$x; + } qr/Storage of references of type 'REF' is not supported/, + 'Storage of ref refs not supported'; + + throws_ok { + $db->{scalarref} = sub { 1 }; + } qr/Storage of references of type 'CODE' is not supported/, + 'Storage of code refs not supported'; + + throws_ok { + my ($fh, $filename) = new_fh; + $db->{scalarref} = $fh; + } qr/Storage of references of type 'GLOB' is not supported/, + 'Storage of glob refs not supported'; + + $db->{scalar} = $x; + TODO: { + todo_skip "Refs to DBM::Deep objects aren't implemented yet", 2; + lives_ok { + $db->{selfref} = \$db->{scalar}; + } "Refs to DBM::Deep objects are ok"; + + is( ${$db->{selfref}}, $x, "A ref to a DBM::Deep object is ok" ); + } } -} -{ - my $db = DBM::Deep->new( $filename ); + { + my $db = $dbm_maker->(); - my $x = 25; - my $y = 30; - is( $db->{scalar}, $x, "Scalar retrieved ok" ); - TODO: { - todo_skip "Scalar refs aren't implemented yet", 2; - is( ${$db->{scalarref}}, 30, "Scalarref retrieved ok" ); - is( ${$db->{selfref}}, 25, "Scalarref to stored scalar retrieved ok" ); + is( $db->{scalar}, $x, "Scalar retrieved ok" ); + TODO: { + todo_skip "Refs to DBM::Deep objects aren't implemented yet", 2; + is( ${$db->{scalarref}}, 30, "Scalarref retrieved ok" ); + is( ${$db->{selfref}}, 26, "Scalarref to stored scalar retrieved ok" ); + } } } + +done_testing;