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

* CanModify should be false for fkLookup and fkCalculated fields. Part of bug #13114

Browse Source 
* Added test for lookup-fields which currently fails for sqldb because TSQLQuert.Lookup isnt implemented

git-svn-id: trunk@12738 -
This commit is contained in:
joost 2009-02-13 22:17:25 +00:00
parent a1b750bc39
commit 6c06a902e2
2 changed files with 44 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -527,9 +527,13 @@ begin
Result:=Not ReadOnly;
If Result then
begin
Result:=Assigned(DataSet);
If Result then
Result:= DataSet.CanModify;
Result := FieldKind in [fkData, fkInternalCalc];
if Result then
begin
Result:=Assigned(DataSet);
If Result then
Result:= DataSet.CanModify;
end;
end;
end;

37
packages/fcl-db/tests/testdbbasics.pas
View File

@ -114,6 +114,7 @@ type
procedure TestRecNo; // bug 5061
procedure TestSetRecNo; // bug 6919
procedure TestRequired;
procedure TestCanModifySpecialFields;
end;
{ TSQLTestSetup }
@ -505,6 +506,42 @@ begin
DBConnector.StopTest;
end;
procedure TTestDBBasics.TestCanModifySpecialFields;
var ds : TDataset;
lds : TDataset;
fld : TField;
begin
lds := DBConnector.GetNDataset(10);
ds := DBConnector.GetNDataset(5);
with ds do
begin
Fld := TIntegerField.Create(ds);
Fld.FieldName:='ID';
Fld.DataSet:=ds;
Fld := TStringField.Create(ds);
Fld.FieldName:='LookupFld';
Fld.FieldKind:=fkLookup;
Fld.DataSet:=ds;
Fld.LookupDataSet:=lds;
Fld.LookupResultField:='NAME';
Fld.LookupKeyFields:='ID';
Fld.KeyFields:='ID';
lds.Open;
Open;
AssertTrue(FieldByName('ID').CanModify);
AssertFalse(FieldByName('LookupFld').CanModify);
AssertFalse(FieldByName('ID').ReadOnly);
AssertFalse(FieldByName('LookupFld').ReadOnly);
AssertEquals(1,FieldByName('ID').AsInteger);
AssertEquals('name1',FieldByName('LookupFld').AsString);
close;
lds.Close;
end;
end;
procedure TTestDBBasics.TestSafeAsXML;
var ds : TDataset;
LoadDs: TBufDataset;