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

* Fixed AV when TFieldDefs has dataset assigned. (+test)

Browse Source 
git-svn-id: trunk@12567 -
This commit is contained in:
joost 2009-01-19 10:02:02 +00:00
parent 4cc8c98f10
commit 7613f3eb5f
2 changed files with 15 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2042,7 +2042,12 @@ procedure TDefCollection.SetItemName(AItem: TCollectionItem);
begin begin
with AItem as TNamedItem do with AItem as TNamedItem do
if Name = '' then if Name = '' then
Name := Dataset.Name + Copy(ClassName, 2, 5) + IntToStr(ID+1) begin
if assigned(Dataset) then
Name := Dataset.Name + Copy(ClassName, 2, 5) + IntToStr(ID+1)
else
Name := Copy(ClassName, 2, 5) + IntToStr(ID+1);
end
else inherited SetItemName(AItem); else inherited SetItemName(AItem);
end; end;

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

@ -21,6 +21,7 @@ type
procedure TestParseSQL; procedure TestParseSQL;
procedure TestInitFielddefsFromFields; procedure TestInitFielddefsFromFields;
procedure TestDoubleFieldDef; procedure TestDoubleFieldDef;
procedure TestFieldDefWithoutDS;
end; end;
implementation implementation
@ -170,6 +171,14 @@ begin
AssertTrue(PassException); AssertTrue(PassException);
end; end;
procedure TTestBasics.TestFieldDefWithoutDS;
var FieldDefs : TFieldDefs;
begin
FieldDefs := TFieldDefs.Create(nil);
FieldDefs.Add('test',ftString);
FieldDefs.Free;
end;
initialization initialization
RegisterTest(TTestBasics); RegisterTest(TTestBasics);
end. end.