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

fcl-db: memds: add support for calculated fields. revealed by TestCalculatedField

Browse Source 
git-svn-id: trunk@25984 -
This commit is contained in:
lacak 2013-11-07 12:10:29 +00:00
parent 441e37b8b4
commit 36249fcee1
2 changed files with 56 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
packages/fcl-db/src/memds/memds.pp
View File

@ -63,7 +63,6 @@ type
FRecInfoOffset: integer; FRecInfoOffset: integer;
FRecCount: integer; FRecCount: integer;
FRecSize: integer; FRecSize: integer;
FRecBufferSize: integer;
FCurrRecNo: integer; FCurrRecNo: integer;
FIsOpen: boolean; FIsOpen: boolean;
FTableIsCreated: boolean; FTableIsCreated: boolean;
@ -77,7 +76,7 @@ type
function MDSGetRecordOffset(ARecNo: integer): longint; function MDSGetRecordOffset(ARecNo: integer): longint;
function MDSGetFieldOffset(FieldNo: integer): integer; function MDSGetFieldOffset(FieldNo: integer): integer;
function MDSGetBufferSize(FieldNo: integer): integer; function MDSGetBufferSize(FieldNo: integer): integer;
function MDSGetActiveBuffer(var Buffer: TRecordBuffer): Boolean; function MDSGetActiveBuffer(out Buffer: TRecordBuffer): Boolean;
procedure MDSReadRecord(Buffer:TRecordBuffer;ARecNo:Integer); procedure MDSReadRecord(Buffer:TRecordBuffer;ARecNo:Integer);
procedure MDSWriteRecord(Buffer:TRecordBuffer;ARecNo:Integer); procedure MDSWriteRecord(Buffer:TRecordBuffer;ARecNo:Integer);
procedure MDSAppendRecord(Buffer:TRecordBuffer); procedure MDSAppendRecord(Buffer:TRecordBuffer);
@ -99,6 +98,7 @@ type
procedure InternalGotoBookmark(ABookmark: Pointer); override; procedure InternalGotoBookmark(ABookmark: Pointer); override;
procedure InternalInitFieldDefs; override; procedure InternalInitFieldDefs; override;
procedure InternalInitRecord(Buffer: TRecordBuffer); override; procedure InternalInitRecord(Buffer: TRecordBuffer); override;
procedure ClearCalcFields(Buffer: TRecordBuffer); override;
procedure InternalLast; override; procedure InternalLast; override;
procedure InternalOpen; override; procedure InternalOpen; override;
procedure InternalPost; override; procedure InternalPost; override;
@ -268,7 +268,6 @@ begin
FStream:=TMemoryStream.Create; FStream:=TMemoryStream.Create;
FRecCount:=0; FRecCount:=0;
FRecSize:=0; FRecSize:=0;
FRecBufferSize:=0;
FRecInfoOffset:=0; FRecInfoOffset:=0;
FCurrRecNo:=-1; FCurrRecNo:=-1;
BookmarkSize := sizeof(Longint); BookmarkSize := sizeof(Longint);
@ -325,6 +324,7 @@ begin
ftLargeInt: result:=SizeOf(int64); ftLargeInt: result:=SizeOf(int64);
ftSmallInt: result:=SizeOf(SmallInt); ftSmallInt: result:=SizeOf(SmallInt);
ftWord, ftWord,
ftAutoInc,
ftInteger: result:=SizeOf(longint); ftInteger: result:=SizeOf(longint);
ftDateTime, ftDateTime,
ftTime, ftTime,
@ -342,7 +342,7 @@ begin
{$ENDIF} {$ENDIF}
end; end;
function TMemDataset.MDSGetActiveBuffer(var Buffer: TRecordBuffer): Boolean; function TMemDataset.MDSGetActiveBuffer(out Buffer: TRecordBuffer): Boolean;
begin begin
case State of case State of
@ -387,7 +387,7 @@ end;
//Abstract Overrides //Abstract Overrides
function TMemDataset.AllocRecordBuffer: TRecordBuffer; function TMemDataset.AllocRecordBuffer: TRecordBuffer;
begin begin
GetMem(Result,FRecBufferSize); GetMem(Result, FRecSize+CalcFieldsSize);
end; end;
procedure TMemDataset.FreeRecordBuffer (var Buffer: TRecordBuffer); procedure TMemDataset.FreeRecordBuffer (var Buffer: TRecordBuffer);
@ -397,7 +397,12 @@ end;
procedure TMemDataset.InternalInitRecord(Buffer: TRecordBuffer); procedure TMemDataset.InternalInitRecord(Buffer: TRecordBuffer);
begin begin
fillchar(Buffer^,FRecSize,0); FillChar(Buffer^,FRecSize,0);
end;
procedure TMemDataset.ClearCalcFields(Buffer: TRecordBuffer);
begin
FillChar(Buffer[RecordSize], CalcFieldsSize, 0);
end; end;
procedure TMemDataset.InternalDelete; procedure TMemDataset.InternalDelete;
@ -429,7 +434,7 @@ begin
FStream.Position:=MDSGetRecordOffset(FCurrRecNo+1); FStream.Position:=MDSGetRecordOffset(FCurrRecNo+1);
TS.CopyFrom(FStream,(MDSGetRecordOffset(FRecCount))-MDSGetRecordOffset(FCurrRecNo+1)); TS.CopyFrom(FStream,(MDSGetRecordOffset(FRecCount))-MDSGetRecordOffset(FCurrRecNo+1));
end; end;
FStream.loadFromStream(TS); FStream.LoadFromStream(TS);
Dec(FRecCount); Dec(FRecCount);
if FRecCount=0 then if FRecCount=0 then
FCurrRecNo:=-1 FCurrRecNo:=-1
@ -483,7 +488,6 @@ begin
B:=ReadInteger(F)<>0; B:=ReadInteger(F)<>0;
TFieldDef.Create(FieldDefs,FN,ft,FS,B,I); TFieldDef.Create(FieldDefs,FN,ft,FS,B,I);
end; end;
CreateTable;
end; end;
procedure TMemDataset.InternalFirst; procedure TMemDataset.InternalFirst;
@ -498,16 +502,16 @@ end;
procedure TMemDataset.InternalOpen; procedure TMemDataset.InternalOpen;
begin begin
if not FTableIsCreated then CreateTable;
If (FFileName<>'') then If (FFileName<>'') then
FOpenStream:=TFileStream.Create(FFileName,fmOpenRead); FOpenStream:=TFileStream.Create(FFileName,fmOpenRead);
Try Try
InternalInitFieldDefs; InternalInitFieldDefs;
if DefaultFields then if DefaultFields then
CreateFields; CreateFields;
BindFields(True); BindFields(True); // BindFields computes CalcFieldsSize
if not FTableIsCreated then
CreateTable;
FCurrRecNo:=-1; FCurrRecNo:=-1;
If (FOpenStream<>Nil) then If (FOpenStream<>Nil) then
begin begin
@ -539,6 +543,7 @@ procedure TMemDataset.LoadFromStream(F: TStream);
begin begin
Close; Close;
ReadFieldDefsFromStream(F); ReadFieldDefsFromStream(F);
CreateTable;
LoadDataFromStream(F); LoadDataFromStream(F);
CheckMarker(F,smEOF); CheckMarker(F,smEOF);
FFileModified:=False; FFileModified:=False;
@ -705,6 +710,7 @@ begin
MDSReadRecord(Buffer, FCurrRecNo); MDSReadRecord(Buffer, FCurrRecNo);
PRecInfo(Buffer+FRecInfoOffset)^.Bookmark:=FCurrRecNo; PRecInfo(Buffer+FRecInfoOffset)^.Bookmark:=FCurrRecNo;
PRecInfo(Buffer+FRecInfoOffset)^.BookmarkFlag:=bfCurrent; PRecInfo(Buffer+FRecInfoOffset)^.BookmarkFlag:=bfCurrent;
GetCalcFields(Buffer);
if (Filtered) then if (Filtered) then
Accepted:=MDSFilterRecord(Buffer) //Filtering Accepted:=MDSFilterRecord(Buffer) //Filtering
else else
@ -721,11 +727,21 @@ var
I: integer; I: integer;
begin begin
I:= Field.FieldNo - 1; I:= Field.FieldNo - 1;
result:= (I >= 0) and MDSGetActiveBuffer(SrcBuffer) and result := MDSGetActiveBuffer(SrcBuffer);
not getfieldisnull(pointer(srcbuffer),I); if not result then Exit;
if result and (buffer <> nil) then
if I >= 0 then
begin begin
Move(GetRecordBufferPointer((SrcBuffer),getintegerpointer(ffieldoffsets,I)^)^, Buffer^,GetIntegerPointer(FFieldSizes, I)^); result := not getfieldisnull(pointer(srcbuffer),I);
if result and assigned(Buffer) then
Move(GetRecordBufferPointer(SrcBuffer, GetIntegerPointer(ffieldoffsets,I)^)^, Buffer^, GetIntegerPointer(FFieldSizes, I)^);
end
else // Calculated, Lookup
begin
Inc(SrcBuffer, RecordSize + Field.Offset);
result := Boolean(SrcBuffer[0]);
if result and assigned(Buffer) then
Move(SrcBuffer[1], Buffer^, Field.DataSize);
end; end;
end; end;
@ -736,22 +752,33 @@ var
begin begin
I:= Field.FieldNo - 1; I:= Field.FieldNo - 1;
if (I >= 0) and MDSGetActiveBuffer(DestBuffer) then if not MDSGetActiveBuffer(DestBuffer) then Exit;
if I >= 0 then
begin begin
if State in [dsEdit, dsInsert, dsNewValue] then if State in [dsEdit, dsInsert, dsNewValue] then
Field.Validate(Buffer); Field.Validate(Buffer);
if buffer = nil then if Buffer = nil then
setfieldisnull(pointer(destbuffer),I) setfieldisnull(pointer(DestBuffer),I)
else else
begin begin
unsetfieldisnull(pointer(destbuffer),I); unsetfieldisnull(pointer(DestBuffer),I);
J:=GetIntegerPointer(FFieldSizes, I)^; J:=GetIntegerPointer(FFieldSizes, I)^;
if Field.DataType=ftString then if Field.DataType=ftString then
Dec(J); // Do not move terminating 0, which is in the size. Dec(J); // Do not move terminating 0, which is in the size.
Move(Buffer^,GetRecordBufferPointer((DestBuffer), getIntegerPointer(FFieldOffsets, I)^)^,J); Move(Buffer^, GetRecordBufferPointer(DestBuffer, getIntegerPointer(FFieldOffsets, I)^)^, J);
dataevent(defieldchange,ptrint(field));
end; end;
end
else // Calculated, Lookup
begin
Inc(DestBuffer, RecordSize + Field.Offset);
Boolean(DestBuffer[0]) := Buffer <> nil;
if assigned(Buffer) then
Move(Buffer^, DestBuffer[1], Field.DataSize);
end; end;
if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
DataEvent(deFieldChange, PtrInt(Field));
end; end;
function TMemDataset.GetRecordSize: Word; function TMemDataset.GetRecordSize: Word;
@ -881,6 +908,8 @@ begin
GetIntegerPointer(ffieldsizes, i)^ := MDSGetbufferSize(i+1); GetIntegerPointer(ffieldsizes, i)^ := MDSGetbufferSize(i+1);
FRecSize:= FRecSize+GetIntegerPointer(FFieldSizes, i)^; FRecSize:= FRecSize+GetIntegerPointer(FFieldSizes, i)^;
end; end;
FRecInfoOffset:=FRecSize;
FRecSize:=FRecSize+SizeRecInfo;
end; end;
procedure TMemDataset.CreateTable; procedure TMemDataset.CreateTable;
@ -892,9 +921,6 @@ begin
FCurrRecNo:=-1; FCurrRecNo:=-1;
FIsOpen:=False; FIsOpen:=False;
calcrecordlayout; calcrecordlayout;
FRecInfoOffset:=FRecSize;
FRecSize:=FRecSize+SizeRecInfo;
FRecBufferSize:=FRecSize;
FTableIsCreated:=True; FTableIsCreated:=True;
end; end;

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

@ -841,7 +841,7 @@ begin
delete; delete;
GotoBookmark(BM2); GotoBookmark(BM2);
CheckEquals(3,FieldByName('id').AsInteger); CheckEquals(3,FieldByName('id').AsInteger,'After #2 deleted');
delete;delete; delete;delete;
@ -2335,7 +2335,7 @@ begin
next; next;
CheckEquals(70000,FieldByName('CALCFLD').asinteger); CheckEquals(70000,FieldByName('CALCFLD').asinteger);
next; next;
CheckEquals(true,FieldByName('CALCFLD').isnull); CheckTrue(FieldByName('CALCFLD').IsNull, '#3 Null');
next; next;
CheckEquals(1234,FieldByName('CALCFLD').AsInteger); CheckEquals(1234,FieldByName('CALCFLD').AsInteger);
if IsUniDirectional then if IsUniDirectional then
@ -2346,7 +2346,7 @@ begin
Edit; Edit;
FieldByName('ID').AsInteger := 10; FieldByName('ID').AsInteger := 10;
Post; Post;
CheckEquals(true,FieldByName('CALCFLD').isnull); CheckTrue(FieldByName('CALCFLD').IsNull, '#10 Null');
end; end;
close; close;
AFld1.Free; AFld1.Free;