2004-06-04: Added individual object tests.

src/dbHost/DBD/Function.pm

@@ -1,4 +1,5 @@
 package DBD::Function;
+use DBD::Util;
 @ISA = qw(DBD::Util);
 
 sub init {

src/dbHost/DBD/Registrar.pm

@@ -1,4 +1,5 @@
 package DBD::Registrar;
+use DBD::Util;
 @ISA = qw(DBD::Util);
 
 sub init {

src/dbHost/test/Breaktable.pl

@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+
+use Test::More tests => 9;
+
+use DBD::Breaktable;
+
+my $bpt = DBD::Breaktable->new('test');
+isa_ok $bpt, 'DBD::Breaktable';
+is $bpt->name, 'test', 'Breakpoint table name';
+is $bpt->points, 0, 'Points == zero';
+$bpt->add_point(0, 0.5);
+is $bpt->points, 1, 'First point added';
+is_deeply $bpt->point(0), [0, 0.5], 'First point correct';
+$bpt->add_point(1, 1.5);
+is $bpt->points, 2, 'Second point added';
+is_deeply $bpt->point(0), [0, 0.5], 'First point still correct';
+is_deeply $bpt->point(1), [1, 1.5], 'Second point correct';
+is_deeply $bpt->point(2), undef, 'Third point undefined';
+

src/dbHost/test/Device.pl

@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+
+use Test::More tests => 16;
+
+use DBD::Device;
+
+my $dev = DBD::Device->new('VME_IO', 'test', '"Device"');
+isa_ok $dev, 'DBD::Device';
+is $dev->name, 'test', 'Device name';
+is $dev->link_type, 'VME_IO', 'Link type';
+is $dev->choice, 'Device', 'Choice string';
+ok $dev->legal_addr('#C0xFEED S123 @xxx'), 'Address legal';
+my %dev_addrs = (
+	CONSTANT  => '12345',
+	PV_LINK   => 'Any:Record.NAME CPP.MS',
+	VME_IO    => '# C1 S2 @Anything',
+	CAMAC_IO  => '# B1 C2 N3 A4 F5 @Anything',
+	RF_IO     => '# R1 M2 D3 E4',
+	AB_IO     => '# L1 A2 C3 S4 @Anything',
+	GPIB_IO   => '# L1 A2 @Anything',
+	BITBUS_IO => '# L1 N2 P3 S4 @Anything',
+	BBGPIB_IO => '# L1 B2 G3 @Anything',
+	VXI_IO    => '# V1 C2 S3 @Anything',
+	INST_IO   => '@Anything'
+);
+while (my ($link, $addr) = each(%dev_addrs)) {
+    $dev->init($link, 'test', '"Device"');
+    ok $dev->legal_addr($addr), "$link address";
+}
+

src/dbHost/test/Driver.pl

@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+
+use Test::More tests => 2;
+
+use DBD::Driver;
+
+my $drv = DBD::Driver->new('test');
+isa_ok $drv, 'DBD::Driver';
+is $drv->name, 'test', 'Driver name';
+

src/dbHost/test/Function.pl

@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+
+use Test::More tests => 2;
+
+use DBD::Function;
+
+my $func = DBD::Function->new('test');
+isa_ok $func, 'DBD::Function';
+is $func->name, 'test', 'Function name';
+

src/dbHost/test/Menu.pl

@@ -0,0 +1,23 @@
+#!/usr/bin/perl
+
+use Test::More tests => 13;
+
+use DBD::Menu;
+
+my $menu = DBD::Menu->new('test');
+isa_ok $menu, 'DBD::Menu';
+is $menu->name, 'test', 'Menu name';
+is $menu->choices, 0, 'Choices == zero';
+$menu->add_choice('ch1', '"Choice 1"');
+is $menu->choices, 1, 'First choice added';
+ok $menu->legal_choice('Choice 1'), 'First choice legal';
+is_deeply $menu->choice(0), ['ch1', 'Choice 1'], 'First choice found';
+$menu->add_choice('ch2', '"Choice 2"');
+is $menu->choices, 2, 'Second choice added';
+ok $menu->legal_choice('Choice 1'), 'First choice still legal';
+is_deeply $menu->choice(0), ['ch1', 'Choice 1'], 'First choice still found';
+ok $menu->legal_choice('Choice 2'), 'Second choice legal';
+is_deeply $menu->choice(1), ['ch2', 'Choice 2'], 'Second choice found';
+ok !$menu->legal_choice('Choice 3'), 'Third choice not legal';
+is_deeply $menu->choice(2), undef, 'Third choice undefined';
+

src/dbHost/test/Recfield.pl

@@ -0,0 +1,16 @@
+#!/usr/bin/perl
+
+use Test::More tests => 7;
+
+use DBD::Recfield;
+
+my $fld = DBD::Recfield->new('test', 'DBF_LONG');
+isa_ok $fld, 'DBD::Recfield';
+is $fld->name, 'test', 'Field name';
+is $fld->dbf_type, 'DBF_LONG', 'Field type';
+is keys %{$fld->attributes}, 0, 'No attributes';
+ok $fld->legal_value("-1234"), 'Legal long value';
+$fld->add_attribute("asl", "ASL0");
+is keys %{$fld->attributes}, 1, "Attribute added";
+$fld->check_valid;
+is $fld->attribute("asl"), "ASL0", "Attribute value";

src/dbHost/test/Registrar.pl

@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+
+use Test::More tests => 2;
+
+use DBD::Registrar;
+
+my $reg = DBD::Registrar->new('test');
+isa_ok $reg, 'DBD::Registrar';
+is $reg->name, 'test', 'Registrar name';
+

src/dbHost/test/Util.pl

@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+
+use Test::More tests => 2;
+
+use DBD::Util;
+
+is unquote('"x"'), 'x', '"unquote"';
+isnt unquote('x""'), 'x', 'unquote""';

src/dbHost/test/Variable.pl

@@ -0,0 +1,12 @@
+#!/usr/bin/perl
+
+use Test::More tests => 4;
+
+use DBD::Variable;
+
+my $ivar = DBD::Variable->new('test');
+isa_ok $ivar, 'DBD::Variable';
+is $ivar->name, 'test', 'Variable name';
+is $ivar->var_type, 'int', 'variable defaults to int';
+my $dvar = DBD::Variable->new('test', 'double');
+is $dvar->var_type, 'double', 'double variable';