Prepare for 1.0020
[dbsrgits/DBM-Deep.git] / t / 30_already_tied.t
index cc5e551..f54a271 100644 (file)
@@ -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;