Converted all relevant tests to use new_dbm instead of new_fh and all tests (except...
[dbsrgits/DBM-Deep.git] / t / 47_odd_reference_behaviors.t
index 956adcb..68162d1 100644 (file)
@@ -1,79 +1,74 @@
-use 5.006;
-
 use strict;
 use warnings FATAL => 'all';
 
-use Test::More tests => 13;
+use Test::More;
 use Test::Exception;
 use Test::Deep;
 
-use t::common qw( new_fh );
+use t::common qw( new_dbm );
 
 use_ok( 'DBM::Deep' );
 
 # This is bug #34819, reported by EJS
 {
-    my ($fh, $filename) = new_fh();
-    my $db = DBM::Deep->new(
-        file => $filename,
-        fh => $fh,
-    );
+    my $dbm_factory = new_dbm();
+    while ( my $dbm_maker = $dbm_factory->() ) {
+        my $db = $dbm_maker->();
 
-    my $bar = bless { foo => 'ope' }, 'Foo';
+        my $bar = bless { foo => 'ope' }, 'Foo';
 
-    eval {
-        $db->{bar} = $bar;
-        $db->{bar} = $bar;
-    };
+        eval {
+            $db->{bar} = $bar;
+            $db->{bar} = $bar;
+        };
 
-    ok(!$@, "repeated object assignment");
-    isa_ok($db->{bar}, 'Foo');
+        ok(!$@, "repeated object assignment");
+        isa_ok($db->{bar}, 'Foo');
+    }
 }
 
 # This is bug #29957, reported by HANENKAMP
 {
-    my ($fh, $filename) = new_fh();
-    my $db = DBM::Deep->new(
-        file => $filename,
-        fh => $fh,
-    );
-
-    $db->{foo} = [];
-
-    for my $value ( 1 .. 3 ) {
-        lives_ok {
-            my $ref = $db->{foo};
-            push @$ref, $value;
-            $db->{foo} = $ref;
-        } "Successfully added value $value";
-    }
+    my $dbm_factory = new_dbm();
+    while ( my $dbm_maker = $dbm_factory->() ) {
+        my $db = $dbm_maker->();
+
+        $db->{foo} = [];
 
-    cmp_deeply( [1,2,3], noclass($db->{foo}), "Everything looks ok" );
+        for my $value ( 1 .. 3 ) {
+            lives_ok {
+                my $ref = $db->{foo};
+                push @$ref, $value;
+                $db->{foo} = $ref;
+            } "Successfully added value $value";
+        }
+
+        cmp_deeply( [1,2,3], noclass($db->{foo}), "Everything looks ok" );
+    }
 }
 
 # This is bug #33863, reported by PJS
 {
-    my ($fh, $filename) = new_fh();
-    my $db = DBM::Deep->new(
-        file => $filename,
-        fh => $fh,
-    );
-
-    $db->{foo} = [ 42 ];
-    my $foo = shift @{ $db->{foo} };
-    cmp_ok( @{ $db->{foo} }, '==', 0, "Shifting a scalar leaves no values" );
-    cmp_ok( $foo, '==', 42, "... And the value is correct." );
-
-    $db->{bar} = [ [] ];
-    my $bar = shift @{ $db->{bar} };
-    cmp_ok( @{ $db->{bar} }, '==', 0, "Shifting an arrayref leaves no values" );
-
-    $db->{baz} = { foo => [ 1 .. 3 ] };
-    $db->{baz2} = [ $db->{baz} ];
-    my $baz2 = shift @{ $db->{baz2} };
-    cmp_ok( @{ $db->{baz2} }, '==', 0, "Shifting an arrayref leaves no values" );
-    ok( exists $db->{baz}{foo} );
-    ok( exists $baz2->{foo} );
+    my $dbm_factory = new_dbm();
+    while ( my $dbm_maker = $dbm_factory->() ) {
+        my $db = $dbm_maker->();
+
+        $db->{foo} = [ 42 ];
+        my $foo = shift @{ $db->{foo} };
+        cmp_ok( @{ $db->{foo} }, '==', 0, "Shifting a scalar leaves no values" );
+        cmp_ok( $foo, '==', 42, "... And the value is correct." );
+
+        $db->{bar} = [ [] ];
+        my $bar = shift @{ $db->{bar} };
+        cmp_ok( @{ $db->{bar} }, '==', 0, "Shifting an arrayref leaves no values" );
+
+        $db->{baz} = { foo => [ 1 .. 3 ] };
+        $db->{baz2} = [ $db->{baz} ];
+        my $baz2 = shift @{ $db->{baz2} };
+        cmp_ok( @{ $db->{baz2} }, '==', 0, "Shifting an arrayref leaves no values" );
+        ok( exists $db->{baz}{foo} );
+        ok( exists $baz2->{foo} );
+    }
 }
 
-__END__
+done_testing;