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

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
rtl/amiga/classes.pp
View File

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

3
rtl/gba/classes.pp
View File

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

3
rtl/go32v2/classes.pp
View File

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

3
rtl/morphos/classes.pp
View File

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

3
rtl/nds/classes.pp
View File

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

3
rtl/netware/classes.pp
View File

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

3
rtl/netwlibc/classes.pp
View File

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

13
rtl/objpas/fgl.pp
View File

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

3
rtl/openbsd/classes.pp
View File

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

3
rtl/os2/classes.pp
View File

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

3
rtl/unix/classes.pp
View File

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

3
rtl/watcom/classes.pp
View File

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

3
rtl/win32/classes.pp
View File

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

3
rtl/win64/classes.pp
View File

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

3
rtl/wince/classes.pp
View File

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