From b20cf681aec332f1ea7bbbc4d033afef5d6187f5 Mon Sep 17 00:00:00 2001 From: Andrew Johnson Date: Thu, 8 Apr 2010 15:47:58 -0500 Subject: [PATCH] 2004-06-04: Added individual object tests. --- src/dbHost/DBD/Function.pm | 1 + src/dbHost/DBD/Registrar.pm | 1 + src/dbHost/test/Breaktable.pl | 19 +++++++++++++++++++ src/dbHost/test/Device.pl | 30 ++++++++++++++++++++++++++++++ src/dbHost/test/Driver.pl | 10 ++++++++++ src/dbHost/test/Function.pl | 10 ++++++++++ src/dbHost/test/Menu.pl | 23 +++++++++++++++++++++++ src/dbHost/test/Recfield.pl | 16 ++++++++++++++++ src/dbHost/test/Registrar.pl | 10 ++++++++++ src/dbHost/test/Util.pl | 8 ++++++++ src/dbHost/test/Variable.pl | 12 ++++++++++++ 11 files changed, 140 insertions(+) create mode 100644 src/dbHost/test/Breaktable.pl create mode 100644 src/dbHost/test/Device.pl create mode 100644 src/dbHost/test/Driver.pl create mode 100644 src/dbHost/test/Function.pl create mode 100644 src/dbHost/test/Menu.pl create mode 100644 src/dbHost/test/Recfield.pl create mode 100644 src/dbHost/test/Registrar.pl create mode 100644 src/dbHost/test/Util.pl create mode 100644 src/dbHost/test/Variable.pl diff --git a/src/dbHost/DBD/Function.pm b/src/dbHost/DBD/Function.pm index ce014b585..f90062d6c 100644 --- a/src/dbHost/DBD/Function.pm +++ b/src/dbHost/DBD/Function.pm @@ -1,4 +1,5 @@ package DBD::Function; +use DBD::Util; @ISA = qw(DBD::Util); sub init { diff --git a/src/dbHost/DBD/Registrar.pm b/src/dbHost/DBD/Registrar.pm index 0eefb98fd..d3c120311 100644 --- a/src/dbHost/DBD/Registrar.pm +++ b/src/dbHost/DBD/Registrar.pm @@ -1,4 +1,5 @@ package DBD::Registrar; +use DBD::Util; @ISA = qw(DBD::Util); sub init { diff --git a/src/dbHost/test/Breaktable.pl b/src/dbHost/test/Breaktable.pl new file mode 100644 index 000000000..09285491a --- /dev/null +++ b/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'; + diff --git a/src/dbHost/test/Device.pl b/src/dbHost/test/Device.pl new file mode 100644 index 000000000..0b960d2a5 --- /dev/null +++ b/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"; +} + diff --git a/src/dbHost/test/Driver.pl b/src/dbHost/test/Driver.pl new file mode 100644 index 000000000..36f065996 --- /dev/null +++ b/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'; + diff --git a/src/dbHost/test/Function.pl b/src/dbHost/test/Function.pl new file mode 100644 index 000000000..7df69e44f --- /dev/null +++ b/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'; + diff --git a/src/dbHost/test/Menu.pl b/src/dbHost/test/Menu.pl new file mode 100644 index 000000000..635c9a6ec --- /dev/null +++ b/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'; + diff --git a/src/dbHost/test/Recfield.pl b/src/dbHost/test/Recfield.pl new file mode 100644 index 000000000..8807f777a --- /dev/null +++ b/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"; diff --git a/src/dbHost/test/Registrar.pl b/src/dbHost/test/Registrar.pl new file mode 100644 index 000000000..326cf0064 --- /dev/null +++ b/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'; + diff --git a/src/dbHost/test/Util.pl b/src/dbHost/test/Util.pl new file mode 100644 index 000000000..7de8c887e --- /dev/null +++ b/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""'; diff --git a/src/dbHost/test/Variable.pl b/src/dbHost/test/Variable.pl new file mode 100644 index 000000000..84f67b0d8 --- /dev/null +++ b/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';