paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 18:09:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

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

git-svn-id: trunk@11090 -
This commit is contained in:
joost 2008-05-26 21:38:08 +00:00
parent c69840519e
commit a53a234189
7 changed files with 65 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
packages/fcl-db/src/base/db.pas
View File

@ -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
(Collection is TOwnedCollection) and
(TFieldDefs(Collection).IndexOf(AValue) >= 0) then
DatabaseErrorFmt(SDuplicateName, [AValue, Collection.ClassName]);
if (AValue <> '') and (Collection is TFieldDefs) then
begin
TmpInd := (TDefCollection(Collection).IndexOf(AValue));
if (TmpInd >= 0) and (TmpInd <> Index) then
DatabaseErrorFmt(SDuplicateName, [AValue, Collection.ClassName]);
end;
FName:=AValue;
inherited SetDisplayName(AValue);
end;

14
packages/fcl-db/src/base/fields.inc
View File

@ -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

2
packages/fcl-db/src/sqldb/interbase/ibconnection.pp
View File

@ -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;

2
packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
View File

@ -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

2
packages/fcl-db/src/sqldb/postgres/pqconnection.pp
View File

@ -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;

18
packages/fcl-db/tests/testbasics.pas
View File

@ -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.

23
packages/fcl-db/tests/testfieldtypes.pas
View File

@ -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