Committed fix for RT#35140

[dbsrgits/DBM-Deep.git] / t / 17_import.t

diff --git a/t/17_import.t b/t/17_import.t
index b4ff262..108aae2 100644 (file)
--- a/t/17_import.t
+++ b/t/17_import.t
@@ -2,16 +2,55 @@
 # DBM::Deep Test
 ##
 use strict;
-use Test::More tests => 11;
+use Test::More tests => 17;
 use Test::Deep;
+use Test::Exception;
 use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
+# Failure cases to make sure that things are caught right.
+foreach my $type ( DBM::Deep->TYPE_HASH, DBM::Deep->TYPE_ARRAY ) {
+    my ($fh, $filename) = new_fh();
+    my $db = DBM::Deep->new({
+        file => $filename,
+        fh => $fh,
+        type => $type,
+    });
+
+    # Load a scalar
+    throws_ok {
+        $db->import( 'foo' );
+    } qr/Cannot import a scalar/, "Importing a scalar to type '$type' fails";
+
+    # Load a ref of the wrong type
+    # Load something with bad stuff in it
+    my $x = 3;
+    if ( $type eq 'A' ) {
+        throws_ok {
+            $db->import( { foo => 'bar' } );
+        } qr/Cannot import a hash into an array/, "Wrong type fails";
+
+        throws_ok {
+            $db->import( [ \$x ] );
+        } qr/Storage of references of type 'SCALAR' is not supported/, "Bad stuff fails";
+    }
+    else {
+        throws_ok {
+            $db->import( [ 1 .. 3 ] );
+        } qr/Cannot import an array into a hash/, "Wrong type fails";
+
+        throws_ok {
+            $db->import( { foo => \$x } );
+        } qr/Storage of references of type 'SCALAR' is not supported/, "Bad stuff fails";
+    }
+}
+
 {
     my ($fh, $filename) = new_fh();
     my $db = DBM::Deep->new({
         file      => $filename,
+        fh => $fh,
         autobless => 1,
     });
 
@@ -25,7 +64,7 @@ use_ok( 'DBM::Deep' );
         hash1 => {
             subkey1 => "subvalue1",
             subkey2 => "subvalue2",
-            subkey3 => bless( {}, 'Foo' ),
+            subkey3 => bless( { a => 'b' }, 'Foo' ),
         }
     };
 
@@ -40,7 +79,7 @@ use_ok( 'DBM::Deep' );
             hash1 => {
                 subkey1 => "subvalue1",
                 subkey2 => "subvalue2",
-                subkey3 => useclass( bless {}, 'Foo' ),
+                subkey3 => useclass( bless { a => 'b' }, 'Foo' ),
             },
         }),
         "Everything matches",
@@ -56,12 +95,10 @@ use_ok( 'DBM::Deep' );
 }
 
 {
-    diag "\nThere seems to be a bug in Clone on Perl 5.9+ that is causing\nthese tests to fail."
-        if $] >= 5.009;
-
     my ($fh, $filename) = new_fh();
     my $db = DBM::Deep->new({
         file => $filename,
+        fh => $fh,
         type => DBM::Deep->TYPE_ARRAY,
     });
 
@@ -95,6 +132,7 @@ use_ok( 'DBM::Deep' );
     my ($fh, $filename) = new_fh();
     my $db = DBM::Deep->new({
         file      => $filename,
+        fh => $fh,
         autobless => 1,
     });
 
@@ -103,7 +141,7 @@ use_ok( 'DBM::Deep' );
     my $x;
     my $struct = {
         key1 => [
-            2, \$x, 3, 
+            2, \$x, 3,
         ],
     };