Fixed naive use of {@_} in TIE*

diff --git a/Changes b/Changes
index 1337639..2e52d9c 100644 (file)
--- a/Changes
+++ b/Changes
@@ -3,6 +3,7 @@ Revision history for DBM::Deep.
 0.97  ??? ?? ??:??:?? 2006 Pacific
     - Reorganization of distribution
     - Migration to Module::Build with EU::MM backwards compatibility
+    - Migration to Test::More (using Test::Exception)
     - Test coverage improved to 89.6% (and climbing)
     - The following methods have been renamed to reflect their private nature:
         - init() is now _init()
@@ -20,6 +21,11 @@ Revision history for DBM::Deep.
         - copy_node() is now _copy_node()
         - throw_error() is now _throw_error()
     - Added Devel::Cover report
+    - The various tied classes have been broken out. This means that testing
+        "ref( $obj ) eq 'DBM::Deep'" will now fail. The correct test is
+        "eval { $obj->isa( 'DBM::Deep' ) }".
+    - The various methods like push and delete now have the same return values as
+      the standard builtins.
 
 0.96  Oct 14 09:55:00 2005 Pacific
     - Fixed build (OS X hidden files killed it)

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 349633d..d127102 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -1168,14 +1168,19 @@ sub _throw_error {
     my $self = $_[0]->_get_self;
        my $error_text = $_[1];
        
-       $self->root->{error} = $error_text;
+    if ( Scalar::Util::blessed $self ) {
+        $self->root->{error} = $error_text;
        
-       unless ($self->root->{debug}) {
+        unless ($self->root->{debug}) {
+            die "DBM::Deep: $error_text\n";
+        }
+
+        warn "DBM::Deep: $error_text\n";
+        return;
+    }
+    else {
         die "DBM::Deep: $error_text\n";
     }
-
-    warn "DBM::Deep: $error_text\n";
-       return;
 }
 
 sub clear_error {

diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm
index cacfea6..1a6b549 100644 (file)
--- a/lib/DBM/Deep/Array.pm
+++ b/lib/DBM/Deep/Array.pm
@@ -14,7 +14,12 @@ sub TIEARRAY {
 ##
     my $class = shift;
     my $args;
-    if (scalar(@_) > 1) { $args = {@_}; }
+    if (scalar(@_) > 1) {
+        if ( @_ % 2 ) {
+            $class->_throw_error( "Odd number of parameters to TIEARRAY" );
+        }
+        $args = {@_};
+    }
     #XXX This use of ref() is bad and is a bug
        elsif (ref($_[0])) { $args = $_[0]; }
        else { $args = { file => shift }; }

diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm
index 1850388..e315a5d 100644 (file)
--- a/lib/DBM/Deep/Hash.pm
+++ b/lib/DBM/Deep/Hash.pm
@@ -14,7 +14,12 @@ sub TIEHASH {
     ##
     my $class = shift;
     my $args;
-    if (scalar(@_) > 1) { $args = {@_}; }
+    if (scalar(@_) > 1) {
+        if ( @_ % 2 ) {
+            $class->_throw_error( "Odd number of parameters to TIEHASH" );
+        }
+        $args = {@_};
+    }
     #XXX This use of ref() is bad and is a bug
     elsif (ref($_[0])) { $args = $_[0]; }
     else { $args = { file => shift }; }

diff --git a/t/20_tie.t b/t/20_tie.t
index 8d28dba..c6e3a2a 100644 (file)
--- a/t/20_tie.t
+++ b/t/20_tie.t
@@ -2,10 +2,10 @@
 # DBM::Deep Test
 ##
 use strict;
-use Test::More;
-BEGIN { plan tests => 10 }
+use Test::More tests => 11;
+use Test::Exception;
 
-use DBM::Deep;
+use_ok( 'DBM::Deep' );
 
 ##
 # testing the various modes of opening a file
@@ -74,7 +74,7 @@ use DBM::Deep;
 # They should be doing (Scalar::Util::reftype($_[0]) eq 'HASH') and then
 # erroring out if it's not.
 TODO: {
-    todo_skip "Naive use of ref()", 1;
+    todo_skip( "Naive use of {\@_}", 1 );
     unlink "t/test.db";
     my %hash;
     my $db = tie %hash, 'DBM::Deep', [
@@ -90,7 +90,7 @@ TODO: {
 }
 
 TODO: {
-    todo_skip "Naive use of ref()", 1;
+    todo_skip( "Naive use of {\@_}", 1 );
     unlink "t/test.db";
     my @array;
     my $db = tie @array, 'DBM::Deep', [
@@ -105,37 +105,12 @@ TODO: {
     else { ok(1); }
 }
 
-# These are testing the naive use of the {@_} construct within TIEHASH and
-# TIEARRAY. Instead, they should be checking (@_ % 2 == 0) and erroring out
-# if it's not.
-TODO: {
-    todo_skip( "Naive use of {\@_}", 1 );
-    unlink "t/test.db";
-    my %hash;
-    my $db = tie %hash, 'DBM::Deep',
-        undef, file => 't/test.db'
-    ;
-
-    if ($db->error()) {
-        print "ERROR: " . $db->error();
-        ok(0);
-        exit(0);
-    }
-    else { ok(1); }
-}
-
-TODO: {
-    todo_skip( "Naive use of {\@_}", 1 );
-    unlink "t/test.db";
-    my @array;
-    my $db = tie @array, 'DBM::Deep',
-        undef, file => 't/test.db'
-    ;
+unlink "t/test.db";
+throws_ok {
+    tie my %hash, 'DBM::Deep', undef, file => 't/test.db';
+} qr/Odd number of parameters/, "Odd number of params to TIEHASH fails";
 
-    if ($db->error()) {
-        print "ERROR: " . $db->error();
-        ok(0);
-        exit(0);
-    }
-    else { ok(1); }
-}
+unlink "t/test.db";
+throws_ok {
+    tie my @array, 'DBM::Deep', undef, file => 't/test.db';
+} qr/Odd number of parameters/, "Odd number of params to TIEARRAY fails";