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

* Fix bug ID #32962, allowing to define multiple indexes in indexdefs

Browse Source 
git-svn-id: trunk@38353 -
This commit is contained in:
michael 2018-02-26 17:19:59 +00:00
parent 45fdd7655d
commit 10d20a57b7
4 changed files with 552 additions and 318 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

File diff suppressed because it is too large Load Diff

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

@ -1068,7 +1068,7 @@ type
Procedure SetItem(Index: Integer; Value: TIndexDef);
public
constructor Create(ADataSet: TDataSet); virtual; overload;
procedure Add(const Name, Fields: string; Options: TIndexOptions);
procedure Add(const Name, Fields: string; Options: TIndexOptions); overload;
Function AddIndexDef: TIndexDef;
function Find(const IndexName: string): TIndexDef;
function FindIndexForFields(const Fields: string): TIndexDef;
@ -2474,14 +2474,19 @@ end;
Function TIndexDefs.AddIndexDef: TIndexDef;
begin
// Result := inherited add as TIndexDef;
Result:=TIndexDef.Create(Self,'','',[]);
Result := inherited add as TIndexDef;
end;
procedure TIndexDefs.Add(const Name, Fields: string; Options: TIndexOptions);
Var
D : TIndexDef;
begin
TIndexDef.Create(Self,Name,Fields,Options);
D:=AddIndexDef;
D.Name:=Name;
D.Fields:=Fields;
D.Options:=Options;
end;
function TIndexDefs.Find(const IndexName: string): TIndexDef;

2
packages/fcl-db/src/base/dbconst.pas
View File

@ -102,7 +102,7 @@ Resourcestring
SNoFieldIndexes = 'No index currently active';
SNotIndexField = 'Field ''%s'' is not indexed and cannot be modified';
SErrUnknownConnectorType = 'Unknown connector type: "%s"';
SNoIndexFieldNameGiven = 'There are no fields selected to base the index on';
SNoIndexFieldNameGiven = 'Cannot create index "%s": No fields available.';
SStreamNotRecognised = 'The data-stream format is not recognized';
SNoReaderClassRegistered = 'There is no TDatapacketReaderClass registered for this kind of data-stream';
SErrCircularDataSourceReferenceNotAllowed = 'Circular datasource references are not allowed.';

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

@ -294,6 +294,7 @@ begin
end;
procedure TTestDBBasics.TestMove;
var i,count : integer;
aDatasource : TDataSource;
aDatalink : TDataLink;
@ -1951,7 +1952,6 @@ begin
end
else
MaxIndexesCount := 3;
try
open;
except
@ -1974,9 +1974,9 @@ begin
while not eof do
begin
if AFieldType=ftString then
CheckTrue(AnsiCompareStr(VarToStr(LastValue),VarToStr(FieldByName('F'+FieldTypeNames[AfieldType]).AsString))<=0)
CheckTrue(AnsiCompareStr(VarToStr(LastValue),VarToStr(FieldByName('F'+FieldTypeNames[AfieldType]).AsString))<=0,'Forward, Correct string value')
else
CheckTrue(LastValue<=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant);
CheckTrue(LastValue<=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant,'Forward, Correct variant value');
LastValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant;
Next;
end;
@ -1984,9 +1984,9 @@ begin
while not bof do
begin
if AFieldType=ftString then
CheckTrue(AnsiCompareStr(VarToStr(LastValue),VarToStr(FieldByName('F'+FieldTypeNames[AfieldType]).AsString))>=0)
CheckTrue(AnsiCompareStr(VarToStr(LastValue),VarToStr(FieldByName('F'+FieldTypeNames[AfieldType]).AsString))>=0,'Backward, Correct string value')
else
CheckTrue(LastValue>=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant);
CheckTrue(LastValue>=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant,'Backward, Correct variant value');
LastValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant;
Prior;
end;
@ -2428,12 +2428,13 @@ begin
with ds do
begin
AFieldType:=ftString;
AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
IndexName:='testindex';
open; //Record 0
Open;
OldStringValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsString;
next; //Now on record 1
CheckTrue(OldStringValue<=FieldByName('F'+FieldTypeNames[AfieldType]).AsString,'Record 0 must be smaller than record 1 with asc sorted index');
CheckTrue(AnsiCompareStr(OldStringValue,FieldByName('F'+FieldTypeNames[AfieldType]).AsString)<=0,'Record 0 must be smaller than record 1 with asc sorted index');
OldStringValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsString;
next; //Now on record 2
CheckTrue(AnsiCompareStr(OldStringValue,FieldByName('F'+FieldTypeNames[AfieldType]).AsString)<=0,'Record 1 must be smaller than record 2 with asc sorted index');
@ -2442,7 +2443,6 @@ begin
edit;
FieldByName('F'+FieldTypeNames[AfieldType]).AsString := 'ZZZ'; //should be sorted last
post;
prior; // Now on record 0
// Check ZZZ is sorted on/after record 0
CheckTrue(AnsiCompareStr('ZZZ',FieldByName('F'+FieldTypeNames[AfieldType]).AsString)>=0, 'Prior>');
@ -2469,7 +2469,6 @@ begin
// empty dataset and other than default index (default_order) active
CheckTrue(BOF, 'No BOF when opening empty dataset');
CheckTrue(EOF, 'No EOF when opening empty dataset');
// append data at end
for i:=20 downto 0 do
AppendRecord([i, inttostr(i)]);
@ -2528,20 +2527,16 @@ begin
with ds do
begin
AFieldType:=ftString;
IndexFieldNames:='F'+FieldTypeNames[AfieldType];
open;
PrevValue:='';
while not eof do
begin
CheckTrue(AnsiCompareStr(FieldByName('F'+FieldTypeNames[AfieldType]).AsString,PrevValue)>=0);
CheckTrue(AnsiCompareStr(FieldByName('F'+FieldTypeNames[AfieldType]).AsString,PrevValue)>=0,IntToStr(RecNo)+': '+FieldByName('F'+FieldTypeNames[AfieldType]).AsString+'>='+PrevValue+' ?');
PrevValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsString;
Next;
end;
CheckEquals('F'+FieldTypeNames[AfieldType],IndexFieldNames);
end;
end;
@ -2552,7 +2547,7 @@ begin
bufds := DBConnector.GetNDataset(5) as TCustomBufDataset;
s := bufds.IndexFieldNames;
s := bufds.IndexName;
AssertTrue(S<>'');
CheckEquals('',S,'Default index name');
bufds.CompareBookmarks(nil,nil);
end;
{$endif fpc}