diff --git a/src/dbHost/DBD.pm b/src/dbHost/DBD.pm index 400d39003..edc403811 100644 --- a/src/dbHost/DBD.pm +++ b/src/dbHost/DBD.pm @@ -13,8 +13,7 @@ use DBD::Variable; use Carp; sub new { - my $proto = shift; - my $class = ref($proto) || $proto; + my ($class) = @_; my $this = { 'DBD::Breaktable' => {}, 'DBD::Driver' => {}, diff --git a/src/dbHost/DBD/Base.pm b/src/dbHost/DBD/Base.pm index f65b99c4b..1c545bd1c 100644 --- a/src/dbHost/DBD/Base.pm +++ b/src/dbHost/DBD/Base.pm @@ -55,15 +55,15 @@ sub warnContext { # Input checking -sub unquote { - my ($string) = @_; - $string =~ m/^"(.*)"$/o and $string = $1; - return $string; +sub unquote (\$) { + my ($s) = @_; + $$s =~ s/^"(.*)"$/$1/o; + return $$s; } sub identifier { - my $id = unquote(shift); - my $what = shift; + my ($id, $what) = @_; + unquote $id; confess "$what undefined!" unless defined $id; $id =~ m/^$RXident$/o or dieContext("Illegal $what '$id'", "Identifiers are used in C code so must start with a letter, followed", @@ -75,7 +75,7 @@ sub identifier { # Output filtering sub escapeCcomment { - $_ = shift; + ($_) = @_; s/\*\//**/; return $_; } @@ -87,8 +87,7 @@ sub escapeCstring { # Base class routines for the DBD component objects sub new { - my $proto = shift; - my $class = ref($proto) || $proto; + my $class = shift; my $this = {}; bless $this, $class; return $this->init(@_); diff --git a/src/dbHost/DBD/Breaktable.pm b/src/dbHost/DBD/Breaktable.pm index 3db134347..5199d61fb 100644 --- a/src/dbHost/DBD/Breaktable.pm +++ b/src/dbHost/DBD/Breaktable.pm @@ -14,9 +14,9 @@ sub init { sub add_point { my ($this, $raw, $eng) = @_; confess "Raw value undefined!" unless defined $raw; - $raw = unquote($raw); confess "Engineering value undefined!" unless defined $eng; - $eng = unquote($eng); + unquote $raw; + unquote $eng; push @{$this->{POINT_LIST}}, [$raw, $eng]; } diff --git a/src/dbHost/DBD/Device.pm b/src/dbHost/DBD/Device.pm index bd60e0075..f439c6d86 100644 --- a/src/dbHost/DBD/Device.pm +++ b/src/dbHost/DBD/Device.pm @@ -18,11 +18,12 @@ my %link_types = ( sub init { my ($this, $link_type, $dset, $choice) = @_; + unquote $choice; dieContext("Unknown link type '$link_type', valid types are:", sort keys %link_types) unless exists $link_types{$link_type}; $this->SUPER::init($dset, "DSET name"); $this->{LINK_TYPE} = $link_type; - $this->{CHOICE} = unquote($choice); + $this->{CHOICE} = $choice; return $this; } @@ -35,10 +36,10 @@ sub choice { } sub legal_addr { - my $this = shift; - my $addr = unquote(shift); - my $rx = $link_types{$this->{LINK_TYPE}}; - return $addr =~ m/^ $rx $/x; + my ($this, $addr) = @_; + my $rx = $link_types{$this->{LINK_TYPE}}; + unquote $addr; + return $addr =~ m/^ $rx $/x; } 1; diff --git a/src/dbHost/DBD/Menu.pm b/src/dbHost/DBD/Menu.pm index 3ab7ccc38..10fff09e5 100644 --- a/src/dbHost/DBD/Menu.pm +++ b/src/dbHost/DBD/Menu.pm @@ -13,7 +13,7 @@ sub init { sub add_choice { my ($this, $name, $value) = @_; $name = identifier($name, "Choice name"); - $value = unquote($value, "Choice value"); + unquote $value; foreach $pair ($this->choices) { dieContext("Duplicate choice name") if ($pair->[0] eq $name); dieContext("Duplicate choice string") if ($pair->[1] eq $value); @@ -32,12 +32,12 @@ sub choice { } sub legal_choice { - my $this = shift; - my $value = unquote(shift); + my ($this, $value) = @_; + unquote $value; return exists $this->{CHOICE_INDEX}->{$value}; } -sub toEnum { +sub toDeclaration { my $this = shift; my @choices = map { "\t" . @{$_}[0] . "\t/* " . escapeCcomment(@{$_}[1]) . " */" diff --git a/src/dbHost/DBD/Parser.pm b/src/dbHost/DBD/Parser.pm index 14f456ef9..7e8c21d29 100644 --- a/src/dbHost/DBD/Parser.pm +++ b/src/dbHost/DBD/Parser.pm @@ -26,10 +26,10 @@ our $debug=0; sub ParseDBD { my $dbd = shift; - $_ = join '', @_; + $_ = shift; while (1) { - if (parseCommon()) {} - elsif (m/\G menu \s* \( \s* $string \s* \) \s* \{/oxgc) { + parseCommon(); + if (m/\G menu \s* \( \s* $string \s* \) \s* \{/oxgc) { print "Menu: $1\n" if $debug; parse_menu($dbd, $1); } @@ -75,24 +75,27 @@ sub ParseDBD { } sub parseCommon { - # Skip leading whitespace - m/\G \s* /oxgc; + while (1) { + # Skip leading whitespace + m/\G \s* /oxgc; - if (m/\G \#\#!BEGIN\{ ( [^}]* ) \}!\#\# \n/oxgc) { - print "File-Begin: $1\n" if $debug; - pushContext("file '$1'"); + if (m/\G \# /oxgc) { + if (m/\G \#!BEGIN\{ ( [^}]* ) \}!\#\# \n/oxgc) { + print "File-Begin: $1\n" if $debug; + pushContext("file '$1'"); + } + elsif (m/\G \#!END\{ ( [^}]* ) \}!\#\# \n?/oxgc) { + print "File-End: $1\n" if $debug; + popContext("file '$1'"); + } + else { + m/\G (.*) \n/oxgc; + print "Comment: $1\n" if $debug; + } + } else { + return; + } } - elsif (m/\G \#\#!END\{ ( [^}]* ) \}!\#\# \n/oxgc) { - print "File-End: $1\n" if $debug; - popContext("file '$1'"); - } - elsif (m/\G \# (.*) \n/oxgc) { - print "Comment: $1\n" if $debug; - } - else { - return 0; - } - return 1; } sub parse_menu { @@ -100,9 +103,8 @@ sub parse_menu { pushContext("menu($name)"); my $menu = DBD::Menu->new($name); while(1) { - if (parseCommon()) {} - elsif (m/\G choice \s* \( \s* $string \s* , - \s* $string \s* \)/oxgc) { + parseCommon(); + if (m/\G choice \s* \( \s* $string \s* , \s* $string \s* \)/oxgc) { print " Menu-Choice: $1, $2\n" if $debug; $menu->add_choice($1, $2); } @@ -123,8 +125,8 @@ sub parse_breaktable { pushContext("breaktable($name)"); my $bt = DBD::Breaktable->new($name); while(1) { - if (parseCommon()) {} - elsif (m/\G point\s* \(\s* $string \s* , \s* $string \s* \)/oxgc) { + parseCommon(); + if (m/\G point\s* \(\s* $string \s* , \s* $string \s* \)/oxgc) { print " Breaktable-Point: $1, $2\n" if $debug; $bt->add_point($1, $2); } @@ -149,9 +151,8 @@ sub parse_recordtype { pushContext("recordtype($name)"); my $rtyp = DBD::Recordtype->new($name); while(1) { - if (parseCommon()) {} - elsif (m/\G field \s* \( \s* $string \s* , - \s* $string \s* \) \s* \{/oxgc) { + parseCommon(); + if (m/\G field \s* \( \s* $string \s* , \s* $string \s* \) \s* \{/oxgc) { print " Recordtype-Field: $1, $2\n" if $debug; parse_field($rtyp, $1, $2); } @@ -172,8 +173,8 @@ sub parse_field { my $fld = DBD::Recfield->new($name, $field_type); pushContext("field($name, $field_type)"); while(1) { - if (parseCommon()) {} - elsif (m/\G (\w+) \s* \( \s* $string \s* \)/oxgc) { + parseCommon(); + if (m/\G (\w+) \s* \( \s* $string \s* \)/oxgc) { print " Field-Attribute: $1, $2\n" if $debug; $fld->add_attribute($1, $2); } diff --git a/src/dbHost/DBD/Recfield.pm b/src/dbHost/DBD/Recfield.pm index b1711c76e..63d7d0d59 100644 --- a/src/dbHost/DBD/Recfield.pm +++ b/src/dbHost/DBD/Recfield.pm @@ -24,17 +24,17 @@ our %field_types = ( # The hash value is a regexp that matches all legal values of this attribute our %field_attrs = ( - asl => qr/ASL[01]/, - initial => qr/.*/, - promptgroup => qr/GUI_\w+/, - prompt => qr/.*/, - special => qr/(?:SPC_\w+|\d{3,})/, - pp => qr/(?:YES|NO|TRUE|FALSE)/, - interest => qr/\d+/, - base => qr/(?:DECIMAL|HEX)/, - size => qr/\d+/, - extra => qr/.*/, - menu => qr/$RXident/o + asl => qr/^ASL[01]$/, + initial => qr/^.*$/, + promptgroup => qr/^GUI_\w+$/, + prompt => qr/^.*$/, + special => qr/^(?:SPC_\w+|\d{3,})$/, + pp => qr/^(?:YES|NO|TRUE|FALSE)$/, + interest => qr/^\d+$/, + base => qr/^(?:DECIMAL|HEX)$/, + size => qr/^\d+$/, + extra => qr/^.*$/, + menu => qr/^$RXident$/o ); sub new { @@ -47,9 +47,8 @@ sub new { } sub init { - my $this = shift; - my $name = shift; - my $type = unquote(shift); + my ($this, $name, $type) = @_; + unquote $type; $this->SUPER::init($name, "record field name"); dieContext("Illegal field type '$type', valid field types are:", sort keys %field_types) unless exists $field_types{$type}; @@ -62,15 +61,24 @@ sub dbf_type { return shift->{DBF_TYPE}; } +sub set_number { + my ($this, $number) = @_; + $this->{NUMBER} = $number; +} + +sub number { + return shift->{NUMBER}; +} + sub add_attribute { - my $this = shift; - my $attr = shift; - my $value = unquote(shift); + my ($this, $attr, $value) = @_; + unquote $value; + my $match = $field_attrs{$attr}; dieContext("Unknown field attribute '$1', valid attributes are:", sort keys %field_attrs) - unless exists $field_attrs{$attr}; + unless defined $match; dieContext("Bad value '$value' for field '$attr' attribute") - unless $value =~ m/^ $field_attrs{$attr} $/x; + unless $value =~ m/$match/; $this->{ATTR_INDEX}->{$attr} = $value; } @@ -84,17 +92,13 @@ sub attribute { } sub check_valid { - my $this = shift; + my ($this) = @_; my $name = $this->name; my $default = $this->attribute("initial"); dieContext("Default value '$default' is invalid for field '$name'") if (defined($default) and !$this->legal_value($default)); } -# dieContext("Menu name missing for field '$name'") -# if ($this->dbf_type eq "DBF_MENU" and -# !defined($this->attribute("menu"))); - sub toDeclaration { my ($this, $ctype) = @_; my $name = lc $this->name; @@ -119,14 +123,14 @@ sub legal_value { } sub check_valid { - my $this = shift; + my ($this) = @_; dieContext("Size missing for DBF_STRING field '$name'") unless exists $this->attributes->{'size'}; $this->SUPER::check_valid; } sub toDeclaration { - my $this = shift; + my ($this) = @_; my $name = lc $this->name; my $size = $this->attribute('size'); my $result = "char ${name}[${size}];"; @@ -192,7 +196,7 @@ sub legal_value { } sub toDeclaration { - return shift->SUPER::toDeclaration("signed short"); + return shift->SUPER::toDeclaration("short"); } @@ -315,6 +319,13 @@ sub legal_value { return 1; } +sub check_valid { + my ($this) = @_; + dieContext("Menu name missing for DBF_MENU field '$name'") + unless defined($this->attribute("menu")); + $this->SUPER::check_valid; +} + sub toDeclaration { return shift->SUPER::toDeclaration("epicsEnum16"); } @@ -397,14 +408,14 @@ sub legal_value { } sub check_valid { - my $this = shift; + my ($this) = @_; dieContext("Type information missing for DBF_NOACCESS field '$name'") unless defined($this->attribute("extra")); $this->SUPER::check_valid; } sub toDeclaration { - my $this = shift; + my ($this) = @_; my $name = lc $this->name; my $result = $this->attribute('extra') . ";"; my $prompt = $this->attribute('prompt'); diff --git a/src/dbHost/DBD/Recordtype.pm b/src/dbHost/DBD/Recordtype.pm index 9708366bc..3160a70f2 100644 --- a/src/dbHost/DBD/Recordtype.pm +++ b/src/dbHost/DBD/Recordtype.pm @@ -21,6 +21,7 @@ sub add_field { dieContext("Duplicate field name '$field_name'") if exists $this->{FIELD_INDEX}->{$field_name}; $field->check_valid; + $field->set_number(scalar @{$this->{FIELD_LIST}}); push @{$this->{FIELD_LIST}}, $field; $this->{FIELD_INDEX}->{$field_name} = $field; } @@ -71,7 +72,7 @@ sub device { return $this->{DEVICE_INDEX}->{$choice}; } -sub toStruct { +sub toDeclaration { my $this = shift; my @fields = map { $_->toDeclaration diff --git a/src/dbHost/DBD/Variable.pm b/src/dbHost/DBD/Variable.pm index c0b78a2ff..11f5a2c05 100644 --- a/src/dbHost/DBD/Variable.pm +++ b/src/dbHost/DBD/Variable.pm @@ -7,7 +7,7 @@ my %var_types = ("int" => 1, "double" => 1); sub init { my ($this, $name, $type) = @_; if (defined $type) { - $type = unquote($type); + unquote $type; } else { $type = "int"; } diff --git a/src/dbHost/Readfile.pm b/src/dbHost/Readfile.pm index dda27e49d..371f3c666 100644 --- a/src/dbHost/Readfile.pm +++ b/src/dbHost/Readfile.pm @@ -15,14 +15,14 @@ sub slurp { my @path = @{$Rpath}; print "slurp($FILE):\n" if $debug; if ($FILE !~ m[/]) { - foreach $dir (@path) { - print " trying $dir/$FILE\n" if $debug; - if (-r "$dir/$FILE") { - $FILE = "$dir/$FILE"; - last; - } - } - die "Can't find file '$FILE'\n" unless -r $FILE; + foreach $dir (@path) { + print " trying $dir/$FILE\n" if $debug; + if (-r "$dir/$FILE") { + $FILE = "$dir/$FILE"; + last; + } + } + die "Can't find file '$FILE'\n" unless -r $FILE; } print " opening $FILE\n" if $debug; open FILE, "<$FILE" or die "Can't open $FILE: $!\n"; @@ -32,16 +32,13 @@ sub slurp { push @lines, "##!END{$FILE}!##\n"; close FILE or die "Error closing $FILE: $!\n"; print " read ", scalar @lines, " lines\n" if $debug; - return @lines; + return join '', @lines; } sub expandMacros { - my ($macros, @input) = @_; - my @output; - foreach (@input) { - push @output, $macros->expandString($_); - } - return @output; + my ($macros, $input) = @_; + return $input unless $macros; + return $macros->expandString($input); } sub splitPath { @@ -56,37 +53,38 @@ my $RXnam = qr/[a-zA-Z0-9_\-:.[\]<>;]+/o; my $string = qr/ ( $RXnam | $RXstr ) /ox; sub unquote { - my ($string) = @_; - $string = $1 if $string =~ m/^"(.*)"$/o; - return $string; + my ($s) = @_; + $s =~ s/^"(.*)"$/$1/o; + return $s; } sub Readfile { my ($file, $macros, $Rpath) = @_; print "Readfile($file)\n" if $debug; - my @input = &expandMacros($macros, &slurp($file, $Rpath)); + my $input = &expandMacros($macros, &slurp($file, $Rpath)); + my @input = split /\n/, $input; my @output; foreach (@input) { - if (m/^ \s* include \s+ $string /ox) { - $arg = &unquote($1); - print " include $arg\n" if $debug; - push @output, "##! include \"$arg\"\n"; - push @output, &Readfile($arg, $macros, $Rpath); - } elsif (m/^ \s* addpath \s+ $string /ox) { - $arg = &unquote($1); - print " addpath $arg\n" if $debug; - push @output, "##! addpath \"$arg\"\n"; - push @{$Rpath}, &splitPath($arg); - } elsif (m/^ \s* path \s+ $string /ox) { - $arg = &unquote($1); - print " path $arg\n" if $debug; - push @output, "##! path \"$arg\"\n"; - @{$Rpath} = &splitPath($arg); - } else { - push @output, $_; - } + if (m/^ \s* include \s+ $string /ox) { + $arg = &unquote($1); + print " include $arg\n" if $debug; + push @output, "##! include \"$arg\""; + push @output, &Readfile($arg, $macros, $Rpath); + } elsif (m/^ \s* addpath \s+ $string /ox) { + $arg = &unquote($1); + print " addpath $arg\n" if $debug; + push @output, "##! addpath \"$arg\""; + push @{$Rpath}, &splitPath($arg); + } elsif (m/^ \s* path \s+ $string /ox) { + $arg = &unquote($1); + print " path $arg\n" if $debug; + push @output, "##! path \"$arg\""; + @{$Rpath} = &splitPath($arg); + } else { + push @output, $_; + } } - return @output; + return join "\n", @output; } 1; diff --git a/src/dbHost/dbToMenuH b/src/dbHost/dbToMenuH index 5c59c3f37..953160743 100755 --- a/src/dbHost/dbToMenuH +++ b/src/dbHost/dbToMenuH @@ -6,16 +6,16 @@ use Getopts; use macLib; use Readfile; -getopts('DI@S@o:') or - die "Usage: dbToMenuH [-D] [-I dir] [-S macro=val] [-o menu.h] file.dbd [menu.h]"; +my $tool = 'dbToMenuH'; +getopts('DI@o:') or + die "Usage: $tool: [-D] [-I dir] [-o menu.h] menu.dbd [menu.h]\n"; my @path = map { split /[:;]/ } @opt_I; -my $macros = macLib->new(@opt_S); my $dbd = DBD->new(); my $infile = shift @ARGV; $infile =~ m/\.dbd$/ or - die "Input file '$infile' must have '.dbd' extension\n"; + die "$tool: Input file '$infile' must have '.dbd' extension\n"; my $outfile; if ($opt_o) { @@ -24,13 +24,15 @@ if ($opt_o) { $outfile = shift @ARGV; } else { ($outfile = $infile) =~ s/\.dbd$/.h/; + $outfile =~ s/^.*\///; } # Derive a name for the include guard -($guard_name = $outfile) =~ tr/a-zA-Z0-9_/_/cs; +my $guard_name = "INC_$outfile"; +$guard_name =~ tr/a-zA-Z0-9_/_/cs; $guard_name =~ s/(_[hH])?$/_H/; -&ParseDBD($dbd, &Readfile($infile, $macros, \@opt_I)); +&ParseDBD($dbd, &Readfile($infile, 0, \@opt_I)); if ($opt_D) { my %filecount; @@ -38,14 +40,14 @@ if ($opt_D) { print "$outfile: ", join(" \\\n ", @uniqfiles), "\n\n"; print map { "$_:\n" } @uniqfiles; } else { - open OUTFILE, ">$outfile" or die "Can't open $outfile: $!\n"; + open OUTFILE, ">$outfile" or die "$tool: Can't open $outfile: $!\n"; print OUTFILE "/* $outfile generated from $infile */\n\n", - "#ifndef INC_${guard_name}\n", - "#define INC_${guard_name}\n\n"; + "#ifndef $guard_name\n", + "#define $guard_name\n\n"; my $menus = $dbd->menus; while (($name, $menu) = each %{$menus}) { - print OUTFILE $menu->toEnum; + print OUTFILE $menu->toDeclaration; } - print OUTFILE "\n#endif /* INC_${guard_name} */\n"; + print OUTFILE "\n#endif /* $guard_name */\n"; close OUTFILE; } diff --git a/src/dbHost/dbToRecordtypeH b/src/dbHost/dbToRecordtypeH index 6c08024c9..a009fec43 100755 --- a/src/dbHost/dbToRecordtypeH +++ b/src/dbHost/dbToRecordtypeH @@ -6,16 +6,16 @@ use Getopts; use macLib; use Readfile; -getopts('DI@S@o:') or - die "Usage: dbToRecordtypeH [-D] [-I dir] [-S macro=val] [-o menu.h] file.dbd [menu.h]"; +my $tool = 'dbToRecordtypeH'; +getopts('DI@o:') or + die "Usage: $tool [-D] [-I dir] [-o xRecord.h] xRecord.dbd [xRecord.h]\n"; my @path = map { split /[:;]/ } @opt_I; -my $macros = macLib->new(@opt_S); my $dbd = DBD->new(); my $infile = shift @ARGV; $infile =~ m/\.dbd$/ or - die "Input file '$infile' must have '.dbd' extension\n"; + die "$tool: Input file '$infile' must have '.dbd' extension\n"; my $outfile; if ($opt_o) { @@ -24,41 +24,65 @@ if ($opt_o) { $outfile = shift @ARGV; } else { ($outfile = $infile) =~ s/\.dbd$/.h/; + $outfile =~ s/^.*\///; + $outfile =~ s/dbCommonRecord/dbCommon/; } # Derive a name for the include guard -my $guard_name = $outfile; +my $guard_name = "INC_$outfile"; $guard_name =~ tr/a-zA-Z0-9_/_/cs; $guard_name =~ s/(_[hH])?$/_H/; -&ParseDBD($dbd, &Readfile($infile, $macros, \@opt_I)); +&ParseDBD($dbd, &Readfile($infile, 0, \@opt_I)); my $rtypes = $dbd->recordtypes; -die "Input file must contain a single recordtype definition.\n" +die "$tool: Input file must contain a single recordtype definition.\n" unless (1 == keys %{$rtypes}); -if ($opt_D) { +if ($opt_D) { # Output dependencies only, to stdout my %filecount; my @uniqfiles = grep { not $filecount{$_}++ } @inputfiles; print "$outfile: ", join(" \\\n ", @uniqfiles), "\n\n"; print map { "$_:\n" } @uniqfiles; } else { - open OUTFILE, ">$outfile" or die "Can't open $outfile: $!\n"; + open OUTFILE, ">$outfile" or die "$tool: Can't open $outfile: $!\n"; print OUTFILE "/* $outfile generated from $infile */\n\n", - "#ifndef INC_${guard_name}\n", - "#define INC_${guard_name}\n\n", + "#ifndef $guard_name\n", + "#define $guard_name\n\n", "#include \"ellLib.h\"\n", "#include \"epicsMutex.h\"\n", "#include \"link.h\"\n", "#include \"epicsTime.h\"\n", - "#include \"epicsTypes.h\"\n\n"; + "#include \"epicsTypes.h\"\n", + "#include \"epicsExport.h\"\n\n", + "#ifdef __cplusplus\n", + "extern \"C\" {\n", + "#endif\n\n"; + my $menus = $dbd->menus; while (($name, $menu) = each %{$menus}) { - print OUTFILE $menu->toEnum; + print OUTFILE $menu->toDeclaration; } - print OUTFILE "\n"; - my ($name, $rtyp) = each %{$rtypes}; - print OUTFILE $rtyp->toStruct; - print OUTFILE "\n#endif /* INC_${guard_name} */\n"; + print OUTFILE "\n" if scalar %{$menus}; + + my ($rn, $rtyp) = each %{$rtypes}; + print OUTFILE $rtyp->toDeclaration; + + unless ($rn eq 'dbCommon') { + print OUTFILE "\nenum {\n", + join(",\n", map { "\t${rn}Record$_" } $rtyp->field_names), + "\n};\n\n"; + + print OUTFILE "#ifdef GEN_SIZE_OFFSET\n", + "static int ${rn}RecordSizeOffset(dbRecordType *pdbRecordType)\n", + "{\n"; + # ... FIXME: add size-offset data, etc. + print OUTFILE "}\n\n", + "epicsExportRegistrar(${rn}RecordSizeOffset);\n\n"; + } + print OUTFILE "#ifdef __cplusplus\n", + "} /* extern \"C\" */\n", + "#endif\n\n", + "#endif /* $guard_name */\n"; close OUTFILE; } diff --git a/src/dbHost/test/Base.pl b/src/dbHost/test/Base.pl deleted file mode 100644 index fd600be51..000000000 --- a/src/dbHost/test/Base.pl +++ /dev/null @@ -1,8 +0,0 @@ -#!/usr/bin/perl - -use Test::More tests => 2; - -use DBD::Base; - -is unquote('"x"'), 'x', '"unquote"'; -isnt unquote('x""'), 'x', 'unquote""'; diff --git a/src/dbHost/test/Recfield.pl b/src/dbHost/test/Recfield.pl index c67448856..d88d11a68 100644 --- a/src/dbHost/test/Recfield.pl +++ b/src/dbHost/test/Recfield.pl @@ -1,12 +1,14 @@ #!/usr/bin/perl -use Test::More tests => 75; +use Test::More tests => 76; use DBD::Recfield; my $fld_string = DBD::Recfield->new('str', 'DBF_STRING'); isa_ok $fld_string, 'DBD::Recfield'; isa_ok $fld_string, 'DBD::Recfield::DBF_STRING'; +$fld_string->set_number(0); +is $fld_string->number, 0, 'Field number'; $fld_string->add_attribute("size", "41"); is keys %{$fld_string->attributes}, 1, "Size set"; ok $fld_string->legal_value("Hello, world!"), 'Legal value'; diff --git a/src/dbHost/test/Recordtype.pl b/src/dbHost/test/Recordtype.pl index d4d47d6c6..a0545b8c0 100644 --- a/src/dbHost/test/Recordtype.pl +++ b/src/dbHost/test/Recordtype.pl @@ -1,6 +1,6 @@ #!/usr/bin/perl -use Test::More tests => 12; +use Test::More tests => 14; use DBD::Recordtype; use DBD::Recfield; @@ -32,6 +32,9 @@ is_deeply \@names, ['NAME', 'DTYP'], 'Field name list'; is $rtyp->field('NAME'), $fld1, 'Field name lookup'; +is $fld1->number, 0, 'Field number 0'; +is $fld2->number, 1, 'Field number 1'; + is $rtyp->devices, 0, 'No devices yet'; my $dev1 = DBD::Device->new('INST_IO', 'testDset', 'test device');