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

* Fixed test TestAddDblIndex

Browse Source 
* Set the function result properly in DBCompareText 
 * Rewrote TBufDataset.Locate, it now uses parts of the indexes-code (+test)

git-svn-id: trunk@10671 -
This commit is contained in:
joost 2008-04-15 21:29:56 +00:00
parent a681f946f8
commit 683f59a70c
2 changed files with 87 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

152
packages/fcl-db/src/base/bufdataset.pas
View File

@ -187,6 +187,7 @@ type
function LoadBuffer(Buffer : PChar): TGetResult;
function GetFieldSize(FieldDef : TFieldDef) : longint;
function GetRecordUpdateBuffer : boolean;
procedure ProcessFieldCompareStruct(AField: TField; var ACompareRec : TDBCompareRec);
procedure SetIndexFieldNames(const AValue: String);
procedure SetIndexName(AValue: String);
{$IFNDEF ARRAYBUF}
@ -303,7 +304,7 @@ end;
function DBCompareText(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
begin
DBCompareTextLen(subValue,aValue,Length(pchar(subValue)),options);
Result := DBCompareTextLen(subValue,aValue,Length(pchar(subValue)),options);
end;
function DBCompareByte(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
@ -463,19 +464,7 @@ begin
for FieldNr:=0 to FieldsAmount-1 do
begin
AField := TField(IndexFields[FieldNr]);
case AField.DataType of
ftString : DBCompareStruct[FieldNr].Comparefunc := @DBCompareText;
ftSmallint : DBCompareStruct[FieldNr].Comparefunc := @DBCompareSmallInt;
ftInteger,ftCurrency,ftBCD : DBCompareStruct[FieldNr].Comparefunc := @DBCompareInt;
ftWord : DBCompareStruct[FieldNr].Comparefunc := @DBCompareWord;
ftBoolean : DBCompareStruct[FieldNr].Comparefunc := @DBCompareByte;
ftFloat : DBCompareStruct[FieldNr].Comparefunc := @DBCompareDouble;
ftDateTime,ftDate,ftTime : DBCompareStruct[FieldNr].Comparefunc := @DBCompareDouble;
ftLargeint : DBCompareStruct[FieldNr].Comparefunc := @DBCompareLargeInt;
else
DatabaseErrorFmt(SErrIndexBasedOnInvField,[AField.FieldName]);
end;
ProcessFieldCompareStruct(AField,DBCompareStruct[FieldNr]);
DBCompareStruct[FieldNr].Desc := (DescIndexFields.IndexOf(AField)>-1);
if (CInsIndexFields.IndexOf(AField)>-1) then
@ -483,9 +472,6 @@ begin
else
DBCompareStruct[FieldNr].Options := [];
DBCompareStruct[FieldNr].Off1:=sizeof(TBufRecLinkItem)*FMaxIndexesCount+FFieldBufPositions[AField.FieldNo-1];
DBCompareStruct[FieldNr].Off2:=DBCompareStruct[FieldNr].Off1;
end;
finally
CInsIndexFields.Free;
@ -972,6 +958,28 @@ begin
Result := (FCurrentUpdateBuffer < length(FUpdateBuffer)) and CompareBuf(FCurrentUpdateBuffer);
end;
procedure TBufDataset.ProcessFieldCompareStruct(AField: TField; var ACompareRec : TDBCompareRec);
begin
case AField.DataType of
ftString : ACompareRec.Comparefunc := @DBCompareText;
ftSmallint : ACompareRec.Comparefunc := @DBCompareSmallInt;
ftInteger, ftCurrency, ftBCD : ACompareRec.Comparefunc :=
@DBCompareInt;
ftWord : ACompareRec.Comparefunc := @DBCompareWord;
ftBoolean : ACompareRec.Comparefunc := @DBCompareByte;
ftFloat : ACompareRec.Comparefunc := @DBCompareDouble;
ftDateTime, ftDate, ftTime : ACompareRec.Comparefunc :=
@DBCompareDouble;
ftLargeint : ACompareRec.Comparefunc := @DBCompareLargeInt;
else
DatabaseErrorFmt(SErrIndexBasedOnInvField, [AField.FieldName]);
end;
ACompareRec.Off1:=sizeof(TBufRecLinkItem)*FMaxIndexesCount+
FFieldBufPositions[AField.FieldNo-1];
ACompareRec.Off2:=ACompareRec.Off1;
end;
procedure TBufDataset.SetIndexFieldNames(const AValue: String);
begin
if AValue<>'' then
@ -2254,96 +2262,62 @@ end;
Function TBufDataset.Locate(const KeyFields: string; const KeyValues: Variant; options: TLocateOptions) : boolean;
var keyfield : TField; // Field to search in
ValueBuffer : pchar; // Pointer to value to search for, in TField' internal format
VBLength : integer;
var CurrLinkItem : PBufRecLinkItem;
bm : TBufBookmark;
SearchFields : TList;
FieldsAmount : Integer;
DBCompareStruct : TDBCompareStruct;
FieldNr : Integer;
StoreDSState : TDataSetState;
FilterBuffer : PChar;
FieldBufPos : PtrInt; // Amount to add to the record buffer to get the FieldBuffer
CurrLinkItem: PBufRecLinkItem;
CurrBuff : pchar;
bm : TBufBookmark;
CheckNull : Boolean;
SaveState : TDataSetState;
begin
{$IFDEF ARRAYBUF}
DatabaseError('Locate is not supported');
{$ELSE}
// For now it is only possible to search in one field at the same time
result := False;
Result := False;
if IsEmpty then exit;
keyfield := FieldByName(keyfields);
CheckNull := VarIsNull(KeyValues);
// Build the DBCompare structure
SearchFields := TList.Create;
try
GetFieldList(SearchFields,KeyFields);
FieldsAmount:=SearchFields.Count;
if FieldsAmount=0 then exit;
if not CheckNull then
begin
SaveState := State;
SetTempState(dsFilter);
keyfield.Value := KeyValues;
RestoreState(SaveState);
FieldBufPos := FFieldBufPositions[keyfield.FieldNo-1];
VBLength := keyfield.DataSize;
ValueBuffer := AllocMem(VBLength);
currbuff := pointer(FCurrentIndex^.FLastRecBuf)+sizeof(TBufRecLinkItem)*FMaxIndexesCount+FieldBufPos;
move(currbuff^,ValueBuffer^,VBLength);
end;
SetLength(DBCompareStruct,FieldsAmount);
for FieldNr:=0 to FieldsAmount-1 do
ProcessFieldCompareStruct(TField(SearchFields[FieldNr]),DBCompareStruct[FieldNr]);
finally
SearchFields.Free;
end;
// Set The filter-buffer
StoreDSState:=State;
SetTempState(dsFilter);
SetFieldValues(keyfields,KeyValues);
CurrLinkItem := FCurrentIndex^.FFirstRecBuf;
FilterBuffer:=IntAllocRecordBuffer;
move(FCurrentIndex^.FLastRecBuf^,FilterBuffer^,FRecordsize+sizeof(TBufRecLinkItem)*FMaxIndexesCount);
SetTempState(StoreDSState);
if CheckNull then
// Iterate through the records until a match is found
while (CurrLinkItem <> FCurrentIndex^.FLastRecBuf) do
begin
repeat
currbuff := pointer(CurrLinkItem)+sizeof(TBufRecLinkItem)*FMaxIndexesCount;
if GetFieldIsnull(pbyte(CurrBuff),keyfield.Fieldno-1) then
if (IndexCompareRecords(FilterBuffer,CurrLinkItem,DBCompareStruct) = 0) then
begin
result := True;
Result := True;
break;
end;
CurrLinkItem := CurrLinkItem^.next;
if CurrLinkItem = FCurrentIndex^.FLastRecBuf then getnextpacket;
until CurrLinkItem = FCurrentIndex^.FLastRecBuf;
end
else if keyfield.DataType = ftString then
begin
repeat
currbuff := pointer(CurrLinkItem)+sizeof(TBufRecLinkItem)*FMaxIndexesCount;
if not GetFieldIsnull(pbyte(CurrBuff),keyfield.Fieldno-1) then
begin
inc(CurrBuff,FieldBufPos);
if DBCompareTextLen(ValueBuffer,CurrBuff,VBLength,options) = 0 then
begin
result := True;
break;
end;
end;
CurrLinkItem := CurrLinkItem^.next;
if CurrLinkItem = FCurrentIndex^.FLastRecBuf then getnextpacket;
until CurrLinkItem = FCurrentIndex^.FLastRecBuf;
end
else
begin
repeat
currbuff := pointer(CurrLinkItem)+sizeof(TBufRecLinkItem)*FMaxIndexesCount;
if not GetFieldIsnull(pbyte(CurrBuff),keyfield.Fieldno-1) then
begin
inc(CurrBuff,FieldBufPos);
if CompareByte(ValueBuffer^,CurrBuff^,VBLength) = 0 then
begin
result := True;
break;
end;
end;
CurrLinkItem := CurrLinkItem^.next;
if CurrLinkItem = FCurrentIndex^.FLastRecBuf then getnextpacket;
until CurrLinkItem = FCurrentIndex^.FLastRecBuf;
if CurrLinkItem = FCurrentIndex^.FLastRecBuf then
getnextpacket;
end;
FreeRecordBuffer(FilterBuffer);
// If a match is found, jump to the found record
if Result then
begin
{$IFDEF ARRAYBUF}
@ -2354,8 +2328,6 @@ begin
bm.BookmarkFlag := bfCurrent;
GotoBookmark(@bm);
end;
ReAllocmem(ValueBuffer,0);
{$ENDIF}
end;

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

@ -30,6 +30,8 @@ type
procedure TestCancelUpdDelete1;
procedure TestCancelUpdDelete2;
procedure TestBookmarks;
procedure TestLocate;
procedure TestFirst;
procedure TestDelete1;
@ -564,6 +566,28 @@ begin
end;
end;
procedure TTestDBBasics.TestLocate;
begin
with DBConnector.GetNDataset(true,13) do
begin
open;
asserttrue(Locate('id',vararrayof([5]),[]));
AssertEquals(5,FieldByName('id').AsInteger);
AssertFalse(Locate('id',vararrayof([15]),[]));
asserttrue(Locate('id',vararrayof([12]),[]));
AssertEquals(12,FieldByName('id').AsInteger);
close;
open;
asserttrue(Locate('id',vararrayof([12]),[]));
AssertEquals(12,FieldByName('id').AsInteger);
asserttrue(Locate('id;name',vararrayof([4,'TestName4']),[]));
AssertEquals(4,FieldByName('id').AsInteger);
assertFalse(Locate('id;name',vararrayof([4,'TestName5']),[]));
end;
end;
procedure TTestDBBasics.TestSetFieldValues;
var PassException : boolean;
begin
@ -1297,7 +1321,7 @@ begin
with ds do
begin
AddIndex('testindex','F'+FieldTypeNames[ftString]+', F'+FieldTypeNames[ftInteger],[]);
AddIndex('testindex','F'+FieldTypeNames[ftString]+'; F'+FieldTypeNames[ftInteger],[]);
FList := TStringList.Create;
FList.Sorted:=true;
FList.CaseSensitive:=True;