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, 4 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 *
#	Content
1	#! /usr/bin/perl -w
2
3	#
4	# test tie interface
5	#
6
7	use Test;
8
9	BEGIN { plan tests => 12 };
10
11	use TDB_FileX ":all";
12
13	{
14	# prime test.tdb
15	my $tdb = TDB_FileX->open ("test.tdb", tdb_flags => CLEAR_IF_FIRST);
16	ok($tdb);
17
18	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	}
22
23	my %db;
24	ok(tie %db, 'TDB_FileX', 'test.tdb');
25
26	ok($db{foo}, 'barbaz');
27	ok($db{foo2}, 'barf');
28
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	ok(scalar keys(%db), 2);
38
39	%db = ();
40	ok(not scalar %db);