t/20_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, "Tied an hash with an array for params" ); }
  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, "Tied a hash with a hashref for params" ); }
  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, "Tied an array with an array for params" ); }
  52
  53     is( $db->{type}, DBM::Deep->TYPE_ARRAY, "TIE_ARRAY sets the correct type" );
  54 }
  55
  56 {
  57     unlink "t/test.db";
  58     my @array;
  59     my $db = tie @array, 'DBM::Deep', {
  60         file => 't/test.db',
  61     };
  62
  63     if ($db->error()) {
  64         print "ERROR: " . $db->error();
  65         ok(0);
  66         exit(0);
  67     }
  68     else { ok(1, "Tied an array with a hashref for params" ); }
  69
  70     is( $db->{type}, DBM::Deep->TYPE_ARRAY, "TIE_ARRAY sets the correct type" );
  71 }
  72
  73 # These are testing the naive use of ref() within TIEHASH and TIEARRAY.
  74 # They should be doing (Scalar::Util::reftype($_[0]) eq 'HASH') and then
  75 # erroring out if it's not.
  76 TODO: {
  77     todo_skip "Naive use of ref()", 1;
  78     unlink "t/test.db";
  79     my %hash;
  80     my $db = tie %hash, 'DBM::Deep', [
  81         file => 't/test.db',
  82     ];
  83
  84     if ($db->error()) {
  85         print "ERROR: " . $db->error();
  86         ok(0);
  87         exit(0);
  88     }
  89     else { ok(1); }
  90 }
  91
  92 TODO: {
  93     todo_skip "Naive use of ref()", 1;
  94     unlink "t/test.db";
  95     my @array;
  96     my $db = tie @array, 'DBM::Deep', [
  97         file => 't/test.db',
  98     ];
  99
 100     if ($db->error()) {
 101         print "ERROR: " . $db->error();
 102         ok(0);
 103         exit(0);
 104     }
 105     else { ok(1); }
 106 }
 107
 108 # These are testing the naive use of the {@_} construct within TIEHASH and
 109 # TIEARRAY. Instead, they should be checking (@_ % 2 == 0) and erroring out
 110 # if it's not.
 111 TODO: {
 112     todo_skip( "Naive use of {\@_}", 1 );
 113     unlink "t/test.db";
 114     my %hash;
 115     my $db = tie %hash, 'DBM::Deep',
 116         undef, file => 't/test.db'
 117     ;
 118
 119     if ($db->error()) {
 120         print "ERROR: " . $db->error();
 121         ok(0);
 122         exit(0);
 123     }
 124     else { ok(1); }
 125 }
 126
 127 TODO: {
 128     todo_skip( "Naive use of {\@_}", 1 );
 129     unlink "t/test.db";
 130     my @array;
 131     my $db = tie @array, 'DBM::Deep',
 132         undef, file => 't/test.db'
 133     ;
 134
 135     if ($db->error()) {
 136         print "ERROR: " . $db->error();
 137         ok(0);
 138         exit(0);
 139     }
 140     else { ok(1); }
 141 }