paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 11:49:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

* enabled type and var keywords in objects for generics

Browse Source 
git-svn-id: trunk@5062 -
This commit is contained in:
florian 2006-10-29 14:20:21 +00:00
parent d4d4309e44
commit ca6f992504
3 changed files with 42 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
compiler/pdecl.pas
View File

@ -38,6 +38,7 @@ interface
procedure const_dec;
procedure label_dec;
procedure type_dec;
procedure types_dec;
procedure var_dec;
procedure threadvar_dec;
procedure property_dec;
@ -369,8 +370,7 @@ implementation
end;
{ reads a type declaration to the symbol table }
procedure type_dec;
procedure types_dec;
function parse_generic_parameters:TFPObjectList;
var
@ -405,7 +405,6 @@ implementation
begin
old_block_type:=block_type;
block_type:=bt_type;
consume(_TYPE);
typecanbeforward:=true;
repeat
defpos:=akttokenpos;
@ -605,6 +604,14 @@ implementation
end;
{ reads a type declaration to the symbol table }
procedure type_dec;
begin
consume(_TYPE);
types_dec;
end;
procedure var_dec;
{ parses variable declarations and inserts them in }
{ the top symbol table of symtablestack }

21
compiler/pdecobj.pas
View File

@ -40,7 +40,7 @@ implementation
symconst,symbase,symsym,symtable,
node,nld,nmem,ncon,ncnv,ncal,
scanner,
pbase,pexpr,pdecsub,pdecvar,ptype
pbase,pexpr,pdecsub,pdecvar,ptype,pdecl
;
const
@ -505,6 +505,7 @@ implementation
dummysymoptions : tsymoptions;
i : longint;
generictype : ttypesym;
current_blocktype : tblock_type;
begin
old_object_option:=current_object_option;
@ -564,9 +565,20 @@ implementation
{ short class declaration ? }
if (classtype<>odt_class) or (token<>_SEMICOLON) then
begin
{ Parse componenten }
{ Parse componenten }
current_blocktype:=bt_general;
repeat
case token of
_TYPE :
begin
consume(_TYPE);
current_blocktype:=bt_type;
end;
_VAR :
begin
consume(_VAR);
current_blocktype:=bt_general;
end;
_ID :
begin
case idtoken of
@ -639,7 +651,10 @@ implementation
not(oo_can_have_published in aktobjectdef.objectoptions) then
Message(parser_e_cant_have_published);
read_record_fields([vd_object]);
if current_blocktype=bt_general then
read_record_fields([vd_object])
else
types_dec;
end;
end;
end;

19
rtl/objpas/fgl.pp
View File

@ -21,15 +21,19 @@ unit fgl;
interface
const
MaxListSize = Maxint div 16;
type
{ TFPList class }
generic TGList<TG> = class(TObject)
type
PTGList = ^TPointerList;
PTGList = ^TTGList;
TTGList = array[0..MaxListSize - 1] of TG;
TListSortCompare = function (Item1, Item2: TG): Integer;
TListCallback = procedure(data,arg: TG) of object;
TListStaticCallback = procedure(data,arg: TG);
var
private
FList: PTGList;
FCount: Integer;
@ -68,6 +72,9 @@ unit fgl;
implementation
uses
rtlconsts,sysutils,classes;
{****************************************************************************}
{* TGList *}
{****************************************************************************}
@ -94,7 +101,7 @@ unit fgl;
end;
function TGList.Extract(item: Pointer): Pointer;
function TGList.Extract(const item: TG): TG;
var
i : Integer;
begin
@ -146,7 +153,7 @@ unit fgl;
end;
function TGList.Add(Item: Pointer): Integer; inline;
function TGList.Add(const Item: TG): Integer; inline;
begin
if FCount = FCapacity then
Self.Expand;
@ -225,7 +232,7 @@ unit fgl;
end;
function TGList.IndexOf(Item: Pointer): Integer;
function TGList.IndexOf(const Item: TG): Integer;
begin
Result := 0;
while(Result < FCount) and (Flist^[Result] <> Item) do Result := Result + 1;
@ -271,7 +278,7 @@ unit fgl;
end;
function TGList.Remove(Item: Pointer): Integer;
function TGList.Remove(const Item: TG): Integer;
begin
Result := IndexOf(Item);
If Result <> -1 then
@ -285,9 +292,11 @@ unit fgl;
Runner : Longint;
begin
// Not the fastest; but surely correct
{
for Runner := Fcount - 1 downto 0 do
if Items[Runner] = Nil then
Self.Delete(Runner);
}
{ The following may be faster in case of large and defragmented lists
If count=0 then exit;
Runner:=0;I:=0;