+ revive generics based tfplist/tstringlist implementation for generics testing; build with FPC_TESTGENERICS

git-svn-id: trunk@7001 -
This commit is contained in:
micha 2007-03-25 19:19:04 +00:00
parent 5acd85f447
commit 3a1b633325
15 changed files with 55 additions and 0 deletions

View File

@ -26,6 +26,9 @@ uses
sysutils, sysutils,
rtlconsts, rtlconsts,
types, types,
{$ifdef FPC_TESTGENERICS}
fgl,
{$endif}
typinfo; typinfo;
{$i classesh.inc} {$i classesh.inc}

View File

@ -24,6 +24,9 @@ uses
sysutils, sysutils,
rtlconsts, rtlconsts,
types, types,
{$ifdef FPC_TESTGENERICS}
fgl,
{$endif}
typinfo; typinfo;
{$i classesh.inc} {$i classesh.inc}

View File

@ -26,6 +26,9 @@ uses
typinfo, typinfo,
rtlconsts, rtlconsts,
types, types,
{$ifdef FPC_TESTGENERICS}
fgl,
{$endif}
sysutils; sysutils;
{$i classesh.inc} {$i classesh.inc}

View File

@ -26,6 +26,9 @@ uses
sysutils, sysutils,
rtlconsts, rtlconsts,
types, types,
{$ifdef FPC_TESTGENERICS}
fgl,
{$endif}
typinfo; typinfo;
{$i classesh.inc} {$i classesh.inc}

View File

@ -24,6 +24,9 @@ uses
sysutils, sysutils,
rtlconsts, rtlconsts,
types, types,
{$ifdef FPC_TESTGENERICS}
fgl,
{$endif}
typinfo; typinfo;
{$i classesh.inc} {$i classesh.inc}

View File

@ -25,6 +25,9 @@ interface
uses uses
sysutils, sysutils,
types, types,
{$ifdef FPC_TESTGENERICS}
fgl,
{$endif}
typinfo, typinfo,
rtlconsts; rtlconsts;

View File

@ -25,6 +25,9 @@ interface
uses uses
sysutils, sysutils,
types, types,
{$ifdef FPC_TESTGENERICS}
fgl,
{$endif}
typinfo, typinfo,
rtlconsts, rtlconsts,
Libc; Libc;

View File

@ -80,15 +80,22 @@ type
{$ifndef VER2_0} {$ifndef VER2_0}
const
MaxGListSize = MaxInt div 1024;
type
generic TFPGList<T> = class(TFPSList) generic TFPGList<T> = class(TFPSList)
type public type public
TCompareFunc = function(const Item1, Item2: T): Integer; TCompareFunc = function(const Item1, Item2: T): Integer;
TTypeList = array[0..MaxGListSize] of T;
PTypeList = ^TTypeList;
PT = ^T; PT = ^T;
var protected var protected
FOnCompare: TCompareFunc; FOnCompare: TCompareFunc;
procedure CopyItem(Src, Dest: Pointer); override; procedure CopyItem(Src, Dest: Pointer); override;
procedure Deref(Item: Pointer); override; procedure Deref(Item: Pointer); override;
function Get(Index: Integer): T; {$ifdef CLASSESINLINE} inline; {$endif} function Get(Index: Integer): T; {$ifdef CLASSESINLINE} inline; {$endif}
function GetList: PTypeList; {$ifdef CLASSESINLINE} inline; {$endif}
function ItemPtrCompare(Item1, Item2: Pointer): Integer; function ItemPtrCompare(Item1, Item2: Pointer): Integer;
procedure Put(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif} procedure Put(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
public public
@ -104,6 +111,7 @@ type
function Remove(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif} function Remove(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
procedure Sort(Compare: TCompareFunc); procedure Sort(Compare: TCompareFunc);
property Items[Index: Integer]: T read Get write Put; default; property Items[Index: Integer]: T read Get write Put; default;
property List: PTypeList read GetList;
end; end;
{$endif} {$endif}
@ -559,6 +567,11 @@ begin
Result := T(inherited Get(Index)^); Result := T(inherited Get(Index)^);
end; end;
function TFPGList.GetList: PTypeList;
begin
Result := PTypeList(FList);
end;
function TFPGList.ItemPtrCompare(Item1, Item2: Pointer): Integer; function TFPGList.ItemPtrCompare(Item1, Item2: Pointer): Integer;
begin begin
Result := FOnCompare(T(Item1^), T(Item2^)); Result := FOnCompare(T(Item1^), T(Item2^));

View File

@ -26,6 +26,9 @@ uses
sysutils, sysutils,
rtlconsts, rtlconsts,
types, types,
{$ifdef FPC_TESTGENERICS}
fgl,
{$endif}
typinfo; typinfo;
{$i classesh.inc} {$i classesh.inc}

View File

@ -26,6 +26,9 @@ uses
sysutils, sysutils,
rtlconsts, rtlconsts,
types, types,
{$ifdef FPC_TESTGENERICS}
fgl,
{$endif}
typinfo; typinfo;
{$i classesh.inc} {$i classesh.inc}

View File

@ -28,6 +28,9 @@ uses
sysutils, sysutils,
types, types,
typinfo, typinfo,
{$ifdef FPC_TESTGENERICS}
fgl,
{$endif}
rtlconsts; rtlconsts;
{$i classesh.inc} {$i classesh.inc}

View File

@ -25,6 +25,9 @@ interface
uses uses
typinfo, typinfo,
rtlconsts, rtlconsts,
{$ifdef FPC_TESTGENERICS}
fgl,
{$endif}
sysutils; sysutils;
{$i classesh.inc} {$i classesh.inc}

View File

@ -26,6 +26,9 @@ uses
rtlconsts, rtlconsts,
sysutils, sysutils,
types, types,
{$ifdef FPC_TESTGENERICS}
fgl,
{$endif}
typinfo, typinfo,
windows; windows;

View File

@ -26,6 +26,9 @@ uses
rtlconsts, rtlconsts,
sysutils, sysutils,
types, types,
{$ifdef FPC_TESTGENERICS}
fgl,
{$endif}
typinfo, typinfo,
windows; windows;

View File

@ -28,6 +28,9 @@ uses
rtlconsts, rtlconsts,
sysutils, sysutils,
types, types,
{$ifdef FPC_TESTGENERICS}
fgl,
{$endif}
typinfo, typinfo,
windows; windows;