[dbsrgits/DBM-Deep.git] / t / 21_tie.t

##
# DBM::Deep Test
##
use strict;
use Test::More;
BEGIN { plan tests => 10 }

use DBM::Deep;

##
# testing the various modes of opening a file
##
{
    unlink "t/test.db";
    my %hash;
    my $db = tie %hash, 'DBM::Deep', 't/test.db';

    if ($db->error()) {
        print "ERROR: " . $db->error();
        ok(0);
        exit(0);
    }
    else { ok(1); }
}

{
    unlink "t/test.db";
    my %hash;
    my $db = tie %hash, 'DBM::Deep', {
        file => 't/test.db',
    };

    if ($db->error()) {
        print "ERROR: " . $db->error();
        ok(0);
        exit(0);
    }
    else { ok(1); }
}

{
    unlink "t/test.db";
    my @array;
    my $db = tie @array, 'DBM::Deep', 't/test.db';

    if ($db->error()) {
        print "ERROR: " . $db->error();
        ok(0);
        exit(0);
    }
    else { ok(1); }

    TODO: {
        local $TODO = "TIE_ARRAY doesn't set the type correctly";
        is( $db->{type}, DBM::Deep->TYPE_ARRAY, "TIE_ARRAY sets the correct type" );
    }
}

{
    unlink "t/test.db";
    my @array;
    my $db = tie @array, 'DBM::Deep', {
        file => 't/test.db',
    };

    if ($db->error()) {
        print "ERROR: " . $db->error();
        ok(0);
        exit(0);
    }
    else { ok(1); }

    TODO: {
        local $TODO = "TIE_ARRAY doesn't set the type correctly";
        is( $db->{type}, DBM::Deep->TYPE_ARRAY, "TIE_ARRAY sets the correct type" );
    }
}

# These are testing the naive use of ref() within TIEHASH and TIEARRAY.
# 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;
    unlink "t/test.db";
    my %hash;
    my $db = tie %hash, 'DBM::Deep', [
        file => 't/test.db',
    ];

    if ($db->error()) {
        print "ERROR: " . $db->error();
        ok(0);
        exit(0);
    }
    else { ok(1); }
}

TODO: {
    todo_skip "Naive use of ref()", 1;
    unlink "t/test.db";
    my @array;
    my $db = tie @array, 'DBM::Deep', [
        file => 't/test.db',
    ];

    if ($db->error()) {
        print "ERROR: " . $db->error();
        ok(0);
        exit(0);
    }
    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'
    ;

    if ($db->error()) {
        print "ERROR: " . $db->error();
        ok(0);
        exit(0);
    }
    else { ok(1); }
}
Commit	Line	Data
ffed8b01	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	}