Merge 3.16 branch into 7.0

modules/database/src/tools/DBD/Parser.pm

@@ -97,7 +97,7 @@ sub ParseDBD {
             my $rtyp = $dbd->recordtype($record_type);
             if (!defined $rtyp) {
                 $rtyp = DBD::Recordtype->new($record_type);
-                warn "Device using undefined record type '$record_type', place-holder created\n";
+                warn "Device using unknown record type '$record_type', declaration created\n";
                 $dbd->add($rtyp);
             }
             $rtyp->add_device(DBD::Device->new($link_type, $dset, $choice));
@@ -218,7 +218,12 @@ sub parse_breaktable {
 sub parse_recordtype {
     my ($dbd, $record_type) = @_;
     pushContext("recordtype($record_type)");
-    my $rtyp = DBD::Recordtype->new($record_type);
+    # Re-use a matching declaration record type if one exists
+    my $rtyp = $dbd->recordtype($record_type);
+    if (!defined($rtyp) || $rtyp->fields) {
+        # Earlier record type is not a declaration, don't re-use it
+        $rtyp = DBD::Recordtype->new($record_type);
+    }
     while(1) {
         parseCommon($rtyp);
         if (m/\G field \s* \( \s* $RXstr \s* , \s* $RXstr \s* \) \s* \{/xgc) {

modules/database/src/tools/DBD/Recfield.pm

@@ -130,7 +130,18 @@ sub attribute {
 }
 
 sub equals {
-    dieContext("Record field objects are not comparable");
+    my ($l, $r) = @_;
+    return 1 if $l eq $r;
+    return 0 if
+        $l->{NAME} ne $r->{NAME} ||
+        $l->{DBF_TYPE} ne $r->{DBF_TYPE};
+    my ($la, $ra) = ($l->{ATTR_INDEX}, $r->{ATTR_INDEX});
+    my @keys = sort keys %$la;
+    return 0 if join(',', @keys) ne join(',', sort keys %$ra);
+    foreach my $k (@keys) {
+        return 0 if $la->{$k} ne $ra->{$k};
+    }
+    return 1;
 }
 
 sub check_valid {

modules/database/src/tools/DBD/Recordtype.pm

@@ -104,9 +104,19 @@ sub pod {
 
 sub equals {
     my ($new, $known) = @_;
-    return 0 if ! $known->fields;
-    return 1 if ! $new->fields;
-    dieContext("Duplicate definition of record type '$known->{NAME}'");
+    return 1 if $new eq $known;
+    return 0 if $new->{NAME} ne $known->{NAME};
+    return 1 if ! $new->fields; # Later declarations always match
+    # NB: Definition after declaration is handled in parse_recordtype()
+    my @nf = @{$new->{FIELD_LIST}};
+    my @kf = @{$known->{FIELD_LIST}};
+    return 0 if scalar @nf != scalar @kf;
+    while (@nf) {
+        my $nf = shift @nf;
+        my $kf = shift @kf;
+        return 0 if ! $nf->equals($kf);
+    }
+    return 1;
 }
 
 sub toDeclaration {