* Raise exception if TFieldDef with existing name is added to TFieldDefs + test

* Allow double field-names in select queries + test (bugs 8457+10819)

git-svn-id: trunk@11090 -

packages/fcl-db/src/base/db.pas

@@ -218,6 +218,7 @@ type
 //    procedure Clear;
 //    procedure Delete(Index: Longint);
     procedure Update; overload;
+    Function MakeNameUnique(const AName : String) : string; virtual;
     Property HiddenFields : Boolean Read FHiddenFields Write FHiddenFields;
     property Items[Index: Longint]: TFieldDef read GetItem write SetItem; default;
   end;
@@ -2011,12 +2012,15 @@ begin
 end;
 
 procedure TNamedItem.SetDisplayName(const AValue: string);
+Var TmpInd : Integer;
 begin
   if FName=AValue then exit;
-  if (AValue <> '') and
+  if (AValue <> '') and (Collection is TFieldDefs) then
-     (Collection is TOwnedCollection) and
+    begin
-     (TFieldDefs(Collection).IndexOf(AValue) >= 0) then
+    TmpInd :=  (TDefCollection(Collection).IndexOf(AValue));
+    if (TmpInd >= 0) and (TmpInd <> Index) then
       DatabaseErrorFmt(SDuplicateName, [AValue, Collection.ClassName]);
+    end;
   FName:=AValue;
   inherited SetDisplayName(AValue);
 end;

packages/fcl-db/src/base/fields.inc

@@ -42,8 +42,8 @@ begin
 {$ifdef dsdebug }
   Writeln('TFieldDef.Create : ',Aname,'(',AFieldNo,')');
 {$endif}
-  Name:=Aname;
   Inherited Create(AOwner);
+  Name:=Aname;
   FDatatype:=ADatatype;
   FSize:=ASize;
   FRequired:=ARequired;
@@ -255,6 +255,18 @@ begin
     end;
 end;
 
+function TFieldDefs.MakeNameUnique(const AName: String): string;
+var DblFieldCount : integer;
+begin
+  DblFieldCount := 0;
+  Result := AName;
+  while assigned(inherited Find(Result)) do
+    begin
+    inc(DblFieldCount);
+    Result := AName + '_' + IntToStr(DblFieldCount);
+    end;
+end;
+
 Function TFieldDefs.AddFieldDef : TFieldDef;
 
 begin

packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -660,7 +660,7 @@ begin
       begin
       TranslateFldType(SQLDA^.SQLVar[x].SQLType, SQLDA^.SQLVar[x].SQLLen, SQLDA^.SQLVar[x].SQLScale,
         TransType, TransLen);
-      FD := TFieldDef.Create(FieldDefs, SQLDA^.SQLVar[x].AliasName, TransType,
+      FD := TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(SQLDA^.SQLVar[x].AliasName), TransType,
          TransLen, False, (x + 1));
       if TransType = ftBCD then FD.precision := SQLDA^.SQLVar[x].SQLLen;
 //      FD.DisplayName := SQLDA^.SQLVar[x].AliasName;

packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -546,7 +546,7 @@ begin
 
     if MySQLDataType(field^.ftype, field^.length, field^.decimals, DFT, DFS) then
       begin
-      TFieldDef.Create(FieldDefs, field^.name, DFT, DFS, False, TF);
+      TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(field^.name), DFT, DFS, False, TF);
       c.MapDSRowToMSQLRow[TF-1] := I;
       inc(TF);
       end

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -632,7 +632,7 @@ begin
     for i := 0 to nFields-1 do
       begin
       fieldtype := TranslateFldType(Res, i,size);
-      with TFieldDef.Create(FieldDefs, PQfname(Res, i), fieldtype,size, False, (i + 1)) do
+      with TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(PQfname(Res, i)), fieldtype,size, False, (i + 1)) do
         FieldBinding[FieldNo-1] := i;
       end;
     CurTuple := -1;

packages/fcl-db/tests/testbasics.pas

@@ -20,6 +20,7 @@ type
   published
     procedure TestParseSQL;
     procedure TestInitFielddefsFromFields;
+    procedure TestDoubleFieldDef;
   end;
 
 implementation
@@ -143,6 +144,23 @@ begin
   CompareFieldAndFieldDef(F3,ds.FieldDefs[2]);
 end;
 
+procedure TTestBasics.TestDoubleFieldDef;
+var ds : TDataset;
+    PassException : boolean;
+begin
+  // If a second field with the same name is added to a TFieldDefs, an exception
+  // should occur
+  ds := TDataset.create(nil);
+  ds.FieldDefs.Add('Field1',ftInteger);
+  PassException:=False;
+  try
+    ds.FieldDefs.Add('Field1',ftString,10,false)
+  except
+    on E: EDatabaseError do PassException := True;
+  end;
+  AssertTrue(PassException);
+end;
+
 initialization
   RegisterTest(TTestBasics);
 end.

packages/fcl-db/tests/testfieldtypes.pas

@@ -30,6 +30,7 @@ type
     procedure TestClearUpdateableStatus;
     procedure TestReadOnlyParseSQL; // bug 9254
     procedure TestParseJoins; // bug 10148
+    procedure TestDoubleFieldNames; // bug 8457
     procedure TestParseUnion; // bug 8442
     procedure TestInsertLargeStrFields; // bug 9600
     procedure TestNumericNames; // Bug9661
@@ -1006,6 +1007,28 @@ begin
     end;
 end;
 
+procedure TTestFieldTypes.TestDoubleFieldNames;
+begin
+  with TSQLDBConnector(DBConnector) do
+    begin
+    with query do
+      begin
+      SQL.Text:='select FPDEV.*,TT.* from FPDEV left join FPDEV TT on TT.ID=FPDEV.ID';
+      Open;
+      AssertTrue(assigned(FindField('ID')));
+      AssertTrue (assigned(FindField('ID_1')));
+      AssertTrue(assigned(FindField('NAME')));
+      AssertTrue(assigned(FindField('NAME_1')));
+      
+      AssertEquals(1,fieldbyname('ID').AsInteger);
+      AssertEquals(1,fieldbyname('ID_1').AsInteger);
+      AssertEquals('TestName1',fieldbyname('NAME').AsString);
+      AssertEquals('TestName1',fieldbyname('NAME_1').AsString);
+      close;
+      end;
+    end;
+end;
+
 procedure TTestFieldTypes.TestParseUnion;
 begin
   with TSQLDBConnector(DBConnector) do