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

* Case-insensitive indexes support

Browse Source 
git-svn-id: trunk@10657 -
This commit is contained in:
joost 2008-04-13 18:35:03 +00:00
parent d7983c3936
commit 809d16257b
2 changed files with 54 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -110,6 +110,7 @@ type
TDBCompareRec = record
Comparefunc : TCompareFunc;
Off1,Off2 : PtrInt;
Options : TLocateOptions;
Desc : Boolean;
end;
TDBCompareStruct = array of TDBCompareRec;
@ -355,7 +356,7 @@ var IndexFieldNr : Integer;
begin
for IndexFieldNr:=0 to length(ADBCompareRecs)-1 do with ADBCompareRecs[IndexFieldNr] do
begin
Result := Comparefunc(Rec1+Off1,Rec2+Off2,[]);
Result := Comparefunc(Rec1+Off1,Rec2+Off2,Options);
if Result <> 0 then
begin
if Desc then
@ -421,6 +422,7 @@ var PCurRecLinkItem : PBufRecLinkItem;
IndexFields : TList;
DescIndexFields : TList;
CInsIndexFields : TList;
FieldsAmount : Integer;
FieldNr : integer;
AField : TField;
@ -449,10 +451,12 @@ begin
begin
IndexFields := TList.Create;
DescIndexFields := TList.Create;
CInsIndexFields := TList.Create;
try
GetFieldList(IndexFields,FieldsName);
FieldsAmount:=IndexFields.Count;
GetFieldList(DescIndexFields,DescFields);
GetFieldList(CInsIndexFields,CaseinsFields);
if FieldsAmount=0 then
DatabaseError(SNoIndexFieldNameGiven);
SetLength(DBCompareStruct,FieldsAmount);
@ -474,12 +478,17 @@ begin
end;
DBCompareStruct[FieldNr].Desc := (DescIndexFields.IndexOf(AField)>-1);
if (CInsIndexFields.IndexOf(AField)>-1) then
DBCompareStruct[FieldNr].Options := [loCaseInsensitive]
else
DBCompareStruct[FieldNr].Options := [];
DBCompareStruct[FieldNr].Off1:=sizeof(TBufRecLinkItem)*FMaxIndexesCount+FFieldBufPositions[AField.FieldNo-1];
DBCompareStruct[FieldNr].Off2:=DBCompareStruct[FieldNr].Off1;
end;
finally
CInsIndexFields.Free;
DescIndexFields.Free;
IndexFields.Free;
end;

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

@ -43,6 +43,7 @@ type
procedure TestAddIndex;
procedure TestAddDescIndex;
procedure TestAddCaseInsIndex;
procedure TestInactSwitchIndex;
procedure TestAddIndexInteger;
@ -1056,6 +1057,49 @@ begin
end;
end;
procedure TTestDBBasics.TestAddCaseInsIndex;
var ds : TBufDataset;
AFieldType : TFieldType;
FList : TStringList;
i : integer;
begin
ds := DBConnector.GetFieldDataset as TBufDataset;
with ds do
begin
AFieldType:=ftString;
AddIndex('testindex','F'+FieldTypeNames[AfieldType],[],'','F'+FieldTypeNames[AfieldType]);
FList := TStringList.Create;
FList.Sorted:=true;
FList.Duplicates:=dupAccept;
open;
while not eof do
begin
flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
Next;
end;
IndexName:='testindex';
first;
i:=0;
while not eof do
begin
AssertEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
inc(i);
Next;
end;
while not bof do
begin
dec(i);
AssertEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
Prior;
end;
end;
end;
procedure TTestDBBasics.TestInactSwitchIndex;
// Test if the default-index is properly build when the active index is not
// the default-index while opening then dataset