t/21_tie.t

   1 ##
   2 # DBM::Deep Test
   3 ##
   4 use strict;
   5 use Test::More;
   6 BEGIN { plan tests => 10 }
   7
   8 use DBM::Deep;
   9
  10 ##
  11 # testing the various modes of opening a file
  12 ##
  13 {
  14     unlink "t/test.db";
  15     my %hash;
  16     my $db = tie %hash, 'DBM::Deep', 't/test.db';
  17
  18     if ($db->error()) {
  19         print "ERROR: " . $db->error();
  20         ok(0);
  21         exit(0);
  22     }
  23     else { ok(1); }
  24 }
  25
  26 {
  27     unlink "t/test.db";
  28     my %hash;
  29     my $db = tie %hash, 'DBM::Deep', {
  30         file => 't/test.db',
  31     };
  32
  33     if ($db->error()) {
  34         print "ERROR: " . $db->error();
  35         ok(0);
  36         exit(0);
  37     }
  38     else { ok(1); }
  39 }
  40
  41 {
  42     unlink "t/test.db";
  43     my @array;
  44     my $db = tie @array, 'DBM::Deep', 't/test.db';
  45
  46     if ($db->error()) {
  47         print "ERROR: " . $db->error();
  48         ok(0);
  49         exit(0);
  50     }
  51     else { ok(1); }
  52
  53     TODO: {
  54         local $TODO = "TIE_ARRAY doesn't set the type correctly";
  55         is( $db->{type}, DBM::Deep->TYPE_ARRAY, "TIE_ARRAY sets the correct type" );
  56     }
  57 }
  58
  59 {
  60     unlink "t/test.db";
  61     my @array;
  62     my $db = tie @array, 'DBM::Deep', {
  63         file => 't/test.db',
  64     };
  65
  66     if ($db->error()) {
  67         print "ERROR: " . $db->error();
  68         ok(0);
  69         exit(0);
  70     }
  71     else { ok(1); }
  72
  73     TODO: {
  74         local $TODO = "TIE_ARRAY doesn't set the type correctly";
  75         is( $db->{type}, DBM::Deep->TYPE_ARRAY, "TIE_ARRAY sets the correct type" );
  76     }
  77 }
  78
  79 # These are testing the naive use of ref() within TIEHASH and TIEARRAY.
  80 # They should be doing (Scalar::Util::reftype($_[0]) eq 'HASH') and then
  81 # erroring out if it's not.
  82 TODO: {
  83     todo_skip "Naive use of ref()", 1;
  84     unlink "t/test.db";
  85     my %hash;
  86     my $db = tie %hash, 'DBM::Deep', [
  87         file => 't/test.db',
  88     ];
  89
  90     if ($db->error()) {
  91         print "ERROR: " . $db->error();
  92         ok(0);
  93         exit(0);
  94     }
  95     else { ok(1); }
  96 }
  97
  98 TODO: {
  99     todo_skip "Naive use of ref()", 1;
 100     unlink "t/test.db";
 101     my @array;
 102     my $db = tie @array, 'DBM::Deep', [
 103         file => 't/test.db',
 104     ];
 105
 106     if ($db->error()) {
 107         print "ERROR: " . $db->error();
 108         ok(0);
 109         exit(0);
 110     }
 111     else { ok(1); }
 112 }
 113
 114 # These are testing the naive use of the {@_} construct within TIEHASH and
 115 # TIEARRAY. Instead, they should be checking (@_ % 2 == 0) and erroring out
 116 # if it's not.
 117 TODO: {
 118     todo_skip( "Naive use of {\@_}", 1 );
 119     unlink "t/test.db";
 120     my %hash;
 121     my $db = tie %hash, 'DBM::Deep',
 122         undef, file => 't/test.db'
 123     ;
 124
 125     if ($db->error()) {
 126         print "ERROR: " . $db->error();
 127         ok(0);
 128         exit(0);
 129     }
 130     else { ok(1); }
 131 }
 132
 133 TODO: {
 134     todo_skip( "Naive use of {\@_}", 1 );
 135     unlink "t/test.db";
 136     my @array;
 137     my $db = tie @array, 'DBM::Deep',
 138         undef, file => 't/test.db'
 139     ;
 140
 141     if ($db->error()) {
 142         print "ERROR: " . $db->error();
 143         ok(0);
 144         exit(0);
 145     }
 146     else { ok(1); }
 147 }