TDB_FileX/t/04_persistent.t

#! /usr/bin/perl -w

#
# test tie interface
#

use Test;

BEGIN { plan tests => 12 };

use TDB_FileX ":all";

{
  # prime test.tdb
  my $tdb = TDB_FileX->open ("test.tdb", tdb_flags => CLEAR_IF_FIRST);
  ok($tdb);

  ok(eval { $tdb->store (foo => 'bar', TDB_FileX::INSERT); 1});
  ok(eval { $tdb->append (foo => 'baz'); 1});
  ok(eval { $tdb->append (foo2 => 'barf'); 1});
}

my %db;
ok(tie %db, 'TDB_FileX', 'test.tdb');

ok($db{foo}, 'barbaz');
ok($db{foo2}, 'barf');

ok(not exists $db{baz});

$db{baz} = 1234;
ok($db{baz}, 1234);

delete $db{baz};
ok(not exists $db{baz});

ok(scalar keys(%db), 2);

%db = ();
ok(not scalar %db);
Revision:	1.2
Committed:	Tue Apr 29 21:27:54 2025 UTC (16 months, 3 weeks ago) by root
Content type:	application/x-troff
Branch:	MAIN
CVS Tags:	rel-0_97, HEAD
Changes since 1.1:	+8 -5 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#! /usr/bin/perl -w
2
3			#
4			# test tie interface
5			#
6
7			use Test;
8
9	root	1.2	BEGIN { plan tests => 12 };
10	root	1.1
11			use TDB_FileX ":all";
12
13			{
14			# prime test.tdb
15	root	1.2	my $tdb = TDB_FileX->open ("test.tdb", tdb_flags => CLEAR_IF_FIRST);
16	root	1.1	ok($tdb);
17
18	root	1.2	ok(eval { $tdb->store (foo => 'bar', TDB_FileX::INSERT); 1});
19			ok(eval { $tdb->append (foo => 'baz'); 1});
20			ok(eval { $tdb->append (foo2 => 'barf'); 1});
21	root	1.1	}
22
23			my %db;
24			ok(tie %db, 'TDB_FileX', 'test.tdb');
25
26	root	1.2	ok($db{foo}, 'barbaz');
27			ok($db{foo2}, 'barf');
28	root	1.1
29			ok(not exists $db{baz});
30
31			$db{baz} = 1234;
32			ok($db{baz}, 1234);
33
34			delete $db{baz};
35			ok(not exists $db{baz});
36
37	root	1.2	ok(scalar keys(%db), 2);
38	root	1.1
39			%db = ();
40			ok(not scalar %db);