=== modified file 'src/tools/DBD.pm' --- src/tools/DBD.pm 2012-03-13 23:00:46 +0000 +++ src/tools/DBD.pm 2012-08-22 19:27:24 +0000 @@ -29,17 +29,18 @@ sub add { my ($this, $obj) = @_; - my $obj_class; - foreach (keys %{$this}) { - next unless m/^DBD::/; - $obj_class = $_ and last if $obj->isa($_); - } - confess "Unknown object type" - unless defined $obj_class; + my $obj_class = ref $obj; + confess "DBD::add: Unknown DBD object type '$obj_class'" + unless $obj_class =~ m/^DBD::/ + and exists $this->{$obj_class}; my $obj_name = $obj->name; - dieContext("Duplicate name '$obj_name'") - if exists $this->{$obj_class}->{$obj_name}; - $this->{$obj_class}->{$obj_name} = $obj; + if (exists $this->{$obj_class}->{$obj_name}) { + return if $obj->equals($this->{$obj_class}->{$obj_name}); + dieContext("A different $obj->{WHAT} named '$obj_name' already exists"); + } + else { + $this->{$obj_class}->{$obj_name} = $obj; + } } sub breaktables { === modified file 'src/tools/DBD/Base.pm' --- src/tools/DBD/Base.pm 2012-06-27 16:58:23 +0000 +++ src/tools/DBD/Base.pm 2012-08-21 22:32:05 +0000 @@ -114,7 +114,8 @@ sub init { my ($this, $name, $what) = @_; - $this->{NAME} = identifier($name, $what); + $this->{NAME} = identifier($name, "$what name"); + $this->{WHAT} = $what; return $this; } @@ -122,4 +123,14 @@ return shift->{NAME}; } +sub what { + return shift->{WHAT}; +} + +sub equals { + my ($a, $b) = @_; + return $a->{NAME} eq $b->{NAME} + && $a->{WHAT} eq $b->{WHAT}; +} + 1; === modified file 'src/tools/DBD/Breaktable.pm' --- src/tools/DBD/Breaktable.pm 2010-04-08 20:55:49 +0000 +++ src/tools/DBD/Breaktable.pm 2012-08-21 22:33:22 +0000 @@ -6,7 +6,7 @@ sub init { my ($this, $name) = @_; - $this->SUPER::init($name, "breakpoint table name"); + $this->SUPER::init($name, "breakpoint table"); $this->{POINT_LIST} = []; return $this; } @@ -29,4 +29,11 @@ return $this->{POINT_LIST}[$idx]; } +sub equals { + my ($a, $b) = @_; + return $a->SUPER::equals($b) + && join(',', map "$_->[0]:$_->[1]", @{$a->{POINT_LIST}}) + eq join(',', map "$_->[0]:$_->[1]", @{$b->{POINT_LIST}}); +} + 1; === modified file 'src/tools/DBD/Device.pm' --- src/tools/DBD/Device.pm 2010-04-08 20:55:49 +0000 +++ src/tools/DBD/Device.pm 2012-08-21 17:20:17 +0000 @@ -21,7 +21,7 @@ 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->SUPER::init($dset, "device support (dset)"); $this->{LINK_TYPE} = $link_type; $this->{CHOICE} = $choice; return $this; @@ -40,6 +40,13 @@ my $rx = $link_types{$this->{LINK_TYPE}}; unquote $addr; return $addr =~ m/^ $rx $/x; +} + +sub equals { + my ($a, $b) = @_; + return $a->SUPER::equals($b) + && $a->{LINK_TYPE} eq $b->{LINK_TYPE} + && $a->{CHOICE} eq $b->{CHOICE}; } 1; === modified file 'src/tools/DBD/Driver.pm' --- src/tools/DBD/Driver.pm 2010-04-08 20:52:36 +0000 +++ src/tools/DBD/Driver.pm 2012-08-21 19:21:16 +0000 @@ -3,7 +3,7 @@ @ISA = qw(DBD::Base); sub init { - return shift->SUPER::init(shift, "driver entry table name"); + return shift->SUPER::init(shift, "driver support (drvet)"); } 1; === modified file 'src/tools/DBD/Function.pm' --- src/tools/DBD/Function.pm 2010-04-08 20:52:36 +0000 +++ src/tools/DBD/Function.pm 2012-08-21 19:21:19 +0000 @@ -3,8 +3,7 @@ @ISA = qw(DBD::Base); sub init { - return shift->SUPER::init(shift, "function name"); + return shift->SUPER::init(shift, "function"); } 1; - === modified file 'src/tools/DBD/Menu.pm' --- src/tools/DBD/Menu.pm 2012-06-27 16:58:23 +0000 +++ src/tools/DBD/Menu.pm 2012-08-21 17:24:46 +0000 @@ -4,7 +4,7 @@ sub init { my ($this, $name) = @_; - $this->SUPER::init($name, "menu name"); + $this->SUPER::init($name, "menu"); $this->{CHOICE_LIST} = []; $this->{CHOICE_INDEX} = {}; return $this; @@ -39,6 +39,13 @@ return exists $this->{CHOICE_INDEX}->{$value}; } +sub equals { + my ($a, $b) = @_; + return $a->SUPER::equals($b) + && join(',', map "$_->[0]:$_->[1]", @{$a->{CHOICE_LIST}}) + eq join(',', map "$_->[0]:$_->[1]", @{$b->{CHOICE_LIST}}); +} + sub toDeclaration { my $this = shift; my $name = $this->name; === modified file 'src/tools/DBD/Recfield.pm' --- src/tools/DBD/Recfield.pm 2010-04-14 20:16:36 +0000 +++ src/tools/DBD/Recfield.pm 2012-08-21 22:43:10 +0000 @@ -49,7 +49,7 @@ sub init { my ($this, $name, $type) = @_; unquote $type; - $this->SUPER::init($name, "record field name"); + $this->SUPER::init($name, "record field"); dieContext("Illegal field type '$type', valid field types are:", sort keys %field_types) unless exists $field_types{$type}; $this->{DBF_TYPE} = $type; @@ -91,6 +91,10 @@ return $this->attributes->{$attr}; } +sub equals { + dieContext("Record field objects are not comparable"); +} + sub check_valid { my ($this) = @_; my $name = $this->name; === modified file 'src/tools/DBD/Recordtype.pm' --- src/tools/DBD/Recordtype.pm 2010-04-08 22:09:59 +0000 +++ src/tools/DBD/Recordtype.pm 2012-08-22 19:33:06 +0000 @@ -5,8 +5,8 @@ use Carp; sub init { - my $this = shift; - $this->SUPER::init(@_); + my ($this, $name) = @_; + $this->SUPER::init($name, "record type"); $this->{FIELD_LIST} = []; $this->{FIELD_INDEX} = {}; $this->{DEVICE_LIST} = []; @@ -50,14 +50,15 @@ confess "Not a DBD::Device" unless $device->isa('DBD::Device'); my $choice = $device->choice; if (exists $this->{DEVICE_INDEX}->{$choice}) { - my @warning = ("Duplicate device type '$choice'"); + return if $device->equals($this->{DEVICE_INDEX}->{$choice}); + my $rnam = $this->{NAME}; + my @warning = ("Two $rnam device supports '$choice' conflict"); my $old = $this->{DEVICE_INDEX}->{$choice}; push @warning, "Link types differ" if ($old->link_type ne $device->link_type); push @warning, "DSETs differ" if ($old->name ne $device->name); - warnContext(@warning); - return; + dieContext(@warning); } push @{$this->{DEVICE_LIST}}, $device; $this->{DEVICE_INDEX}->{$choice} = $device; @@ -85,6 +86,11 @@ return join("\n", shift->cdefs) . "\n\n"; } +sub equals { + my ($a, $b) = @_; + dieContext("Duplicate definition of record type '$a->{NAME}'"); +} + sub toDeclaration { my $this = shift; my @fields = map { === modified file 'src/tools/DBD/Registrar.pm' --- src/tools/DBD/Registrar.pm 2010-04-08 20:52:36 +0000 +++ src/tools/DBD/Registrar.pm 2012-08-21 19:21:26 +0000 @@ -3,9 +3,7 @@ @ISA = qw(DBD::Base); sub init { - return shift->SUPER::init(shift, "registrar function name"); + return shift->SUPER::init(shift, "registrar function"); } - 1; - === modified file 'src/tools/DBD/Variable.pm' --- src/tools/DBD/Variable.pm 2012-03-27 15:47:59 +0000 +++ src/tools/DBD/Variable.pm 2012-08-21 17:00:00 +0000 @@ -18,7 +18,7 @@ exists $valid_types{$type} or dieContext("Unknown variable type '$type', valid types are:", sort keys %valid_types); - $this->SUPER::init($name, "variable name"); + $this->SUPER::init($name, "variable"); $this->{VAR_TYPE} = $type; return $this; } @@ -33,4 +33,10 @@ return $valid_types{$this->{VAR_TYPE}}; } +sub equals { + my ($a, $b) = @_; + return $a->SUPER::equals($b) + && $a->{VAR_TYPE} eq $b->{VAR_TYPE}; +} + 1;