mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-22 11:49:42 +02:00
+ revive generics based tfplist/tstringlist implementation for generics testing; build with FPC_TESTGENERICS
git-svn-id: trunk@7001 -
This commit is contained in:
parent
5acd85f447
commit
3a1b633325
@ -26,6 +26,9 @@ uses
|
|||||||
sysutils,
|
sysutils,
|
||||||
rtlconsts,
|
rtlconsts,
|
||||||
types,
|
types,
|
||||||
|
{$ifdef FPC_TESTGENERICS}
|
||||||
|
fgl,
|
||||||
|
{$endif}
|
||||||
typinfo;
|
typinfo;
|
||||||
|
|
||||||
{$i classesh.inc}
|
{$i classesh.inc}
|
||||||
|
@ -24,6 +24,9 @@ uses
|
|||||||
sysutils,
|
sysutils,
|
||||||
rtlconsts,
|
rtlconsts,
|
||||||
types,
|
types,
|
||||||
|
{$ifdef FPC_TESTGENERICS}
|
||||||
|
fgl,
|
||||||
|
{$endif}
|
||||||
typinfo;
|
typinfo;
|
||||||
|
|
||||||
{$i classesh.inc}
|
{$i classesh.inc}
|
||||||
|
@ -26,6 +26,9 @@ uses
|
|||||||
typinfo,
|
typinfo,
|
||||||
rtlconsts,
|
rtlconsts,
|
||||||
types,
|
types,
|
||||||
|
{$ifdef FPC_TESTGENERICS}
|
||||||
|
fgl,
|
||||||
|
{$endif}
|
||||||
sysutils;
|
sysutils;
|
||||||
|
|
||||||
{$i classesh.inc}
|
{$i classesh.inc}
|
||||||
|
@ -26,6 +26,9 @@ uses
|
|||||||
sysutils,
|
sysutils,
|
||||||
rtlconsts,
|
rtlconsts,
|
||||||
types,
|
types,
|
||||||
|
{$ifdef FPC_TESTGENERICS}
|
||||||
|
fgl,
|
||||||
|
{$endif}
|
||||||
typinfo;
|
typinfo;
|
||||||
|
|
||||||
{$i classesh.inc}
|
{$i classesh.inc}
|
||||||
|
@ -24,6 +24,9 @@ uses
|
|||||||
sysutils,
|
sysutils,
|
||||||
rtlconsts,
|
rtlconsts,
|
||||||
types,
|
types,
|
||||||
|
{$ifdef FPC_TESTGENERICS}
|
||||||
|
fgl,
|
||||||
|
{$endif}
|
||||||
typinfo;
|
typinfo;
|
||||||
|
|
||||||
{$i classesh.inc}
|
{$i classesh.inc}
|
||||||
|
@ -25,6 +25,9 @@ interface
|
|||||||
uses
|
uses
|
||||||
sysutils,
|
sysutils,
|
||||||
types,
|
types,
|
||||||
|
{$ifdef FPC_TESTGENERICS}
|
||||||
|
fgl,
|
||||||
|
{$endif}
|
||||||
typinfo,
|
typinfo,
|
||||||
rtlconsts;
|
rtlconsts;
|
||||||
|
|
||||||
|
@ -25,6 +25,9 @@ interface
|
|||||||
uses
|
uses
|
||||||
sysutils,
|
sysutils,
|
||||||
types,
|
types,
|
||||||
|
{$ifdef FPC_TESTGENERICS}
|
||||||
|
fgl,
|
||||||
|
{$endif}
|
||||||
typinfo,
|
typinfo,
|
||||||
rtlconsts,
|
rtlconsts,
|
||||||
Libc;
|
Libc;
|
||||||
|
@ -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^));
|
||||||
|
@ -26,6 +26,9 @@ uses
|
|||||||
sysutils,
|
sysutils,
|
||||||
rtlconsts,
|
rtlconsts,
|
||||||
types,
|
types,
|
||||||
|
{$ifdef FPC_TESTGENERICS}
|
||||||
|
fgl,
|
||||||
|
{$endif}
|
||||||
typinfo;
|
typinfo;
|
||||||
|
|
||||||
{$i classesh.inc}
|
{$i classesh.inc}
|
||||||
|
@ -26,6 +26,9 @@ uses
|
|||||||
sysutils,
|
sysutils,
|
||||||
rtlconsts,
|
rtlconsts,
|
||||||
types,
|
types,
|
||||||
|
{$ifdef FPC_TESTGENERICS}
|
||||||
|
fgl,
|
||||||
|
{$endif}
|
||||||
typinfo;
|
typinfo;
|
||||||
|
|
||||||
{$i classesh.inc}
|
{$i classesh.inc}
|
||||||
|
@ -28,6 +28,9 @@ uses
|
|||||||
sysutils,
|
sysutils,
|
||||||
types,
|
types,
|
||||||
typinfo,
|
typinfo,
|
||||||
|
{$ifdef FPC_TESTGENERICS}
|
||||||
|
fgl,
|
||||||
|
{$endif}
|
||||||
rtlconsts;
|
rtlconsts;
|
||||||
|
|
||||||
{$i classesh.inc}
|
{$i classesh.inc}
|
||||||
|
@ -25,6 +25,9 @@ interface
|
|||||||
uses
|
uses
|
||||||
typinfo,
|
typinfo,
|
||||||
rtlconsts,
|
rtlconsts,
|
||||||
|
{$ifdef FPC_TESTGENERICS}
|
||||||
|
fgl,
|
||||||
|
{$endif}
|
||||||
sysutils;
|
sysutils;
|
||||||
|
|
||||||
{$i classesh.inc}
|
{$i classesh.inc}
|
||||||
|
@ -26,6 +26,9 @@ uses
|
|||||||
rtlconsts,
|
rtlconsts,
|
||||||
sysutils,
|
sysutils,
|
||||||
types,
|
types,
|
||||||
|
{$ifdef FPC_TESTGENERICS}
|
||||||
|
fgl,
|
||||||
|
{$endif}
|
||||||
typinfo,
|
typinfo,
|
||||||
windows;
|
windows;
|
||||||
|
|
||||||
|
@ -26,6 +26,9 @@ uses
|
|||||||
rtlconsts,
|
rtlconsts,
|
||||||
sysutils,
|
sysutils,
|
||||||
types,
|
types,
|
||||||
|
{$ifdef FPC_TESTGENERICS}
|
||||||
|
fgl,
|
||||||
|
{$endif}
|
||||||
typinfo,
|
typinfo,
|
||||||
windows;
|
windows;
|
||||||
|
|
||||||
|
@ -28,6 +28,9 @@ uses
|
|||||||
rtlconsts,
|
rtlconsts,
|
||||||
sysutils,
|
sysutils,
|
||||||
types,
|
types,
|
||||||
|
{$ifdef FPC_TESTGENERICS}
|
||||||
|
fgl,
|
||||||
|
{$endif}
|
||||||
typinfo,
|
typinfo,
|
||||||
windows;
|
windows;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user