paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 01:09:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

compiler: implement generics for records based on generic objects implementation + 1 test

Browse Source 
git-svn-id: trunk@16670 -
This commit is contained in:
paul 2010-12-31 03:43:16 +00:00
parent 101f545ad0
commit 52667b6822
6 changed files with 59 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -9412,6 +9412,7 @@ tests/test/tgeneric20.pp svneol=native#text/pascal
tests/test/tgeneric21.pp svneol=native#text/pascal
tests/test/tgeneric22.pp svneol=native#text/pascal
tests/test/tgeneric23.pp svneol=native#text/pascal
tests/test/tgeneric24.pp svneol=native#text/pascal
tests/test/tgeneric3.pp svneol=native#text/plain
tests/test/tgeneric4.pp svneol=native#text/plain
tests/test/tgeneric5.pp svneol=native#text/plain

3
compiler/pdecobj.pas
View File

@ -37,6 +37,7 @@ interface
function constructor_head:tprocdef;
function destructor_head:tprocdef;
procedure struct_property_dec(is_classproperty:boolean);
procedure insert_generic_parameter_types(genericdef:tstoreddef;genericlist:TFPObjectList);
implementation
@ -591,7 +592,7 @@ implementation
pd : tprocdef;
has_destructor,
oldparse_only,
old_parse_generic : boolean;
old_parse_generic: boolean;
object_member_blocktype : tblock_type;
fields_allowed, is_classdef, classfields: boolean;
vdoptions: tvar_dec_options;

8
compiler/pdecsub.pas
View File

@ -1152,9 +1152,9 @@ implementation
old_current_specializedef:=current_specializedef;
current_structdef:=pd.struct;
if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then
current_genericdef:=tobjectdef(current_structdef);
current_genericdef:=current_structdef;
if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then
current_specializedef:=tobjectdef(current_structdef);
current_specializedef:=current_structdef;
end;
{ Add parameter symtable }
if pd.parast.symtabletype<>staticsymtable then
@ -1207,9 +1207,9 @@ implementation
old_current_specializedef:=current_specializedef;
current_structdef:=pd.struct;
if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then
current_genericdef:=tobjectdef(current_structdef);
current_genericdef:=current_structdef;
if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then
current_specializedef:=tobjectdef(current_structdef);
current_specializedef:=current_structdef;
end;
single_type(pd.returndef,false,false);

4
compiler/psub.pas
View File

@ -1401,9 +1401,9 @@ implementation
current_procinfo:=self;
current_structdef:=procdef.struct;
if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then
current_genericdef:=tobjectdef(current_structdef);
current_genericdef:=current_structdef;
if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then
current_specializedef:=tobjectdef(current_structdef);
current_specializedef:=current_structdef;
{ calculate the lexical level }
if procdef.parast.symtablelevel>maxnesting then

39
compiler/ptype.pas
View File

@ -835,12 +835,21 @@ implementation
end;
{ reads a record declaration }
function record_dec(const n:tidstring):tdef;
function record_dec(const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList):tdef;
var
old_current_structdef : tabstractrecorddef;
recst : trecordsymtable;
old_current_structdef,
old_current_genericdef,
old_current_specializedef: tabstractrecorddef;
old_parse_generic: boolean;
recst: trecordsymtable;
begin
old_current_structdef:=current_structdef;
old_current_genericdef:=current_genericdef;
old_current_specializedef:=current_specializedef;
old_parse_generic:=parse_generic;
current_genericdef:=nil;
current_specializedef:=nil;
{ create recdef }
recst:=trecordsymtable.create(n,current_settings.packrecords);
current_structdef:=trecorddef.create(n,recst);
@ -849,20 +858,34 @@ implementation
symtablestack.push(recst);
{ parse record }
consume(_RECORD);
{ usage of specialized type inside its generic template }
if assigned(genericdef) then
current_specializedef:=current_structdef
{ reject declaration of generic class inside generic class }
else if assigned(genericlist) then
current_genericdef:=current_structdef;
insert_generic_parameter_types(genericdef,genericlist);
parse_generic:=(df_generic in current_structdef.defoptions);
if m_advanced_records in current_settings.modeswitches then
parse_record_members
else
begin
read_record_fields([vd_record]);
consume(_END);
end;
read_record_fields([vd_record]);
consume(_END);
end;
{ make the record size aligned }
recst.addalignmentpadding;
{ restore symtable stack }
symtablestack.pop(recst);
if trecorddef(current_structdef).is_packed and is_managed_type(current_structdef) then
Message(type_e_no_packed_inittable);
{ restore old state }
parse_generic:=old_parse_generic;
current_structdef:=old_current_structdef;
current_genericdef:=old_current_genericdef;
current_specializedef:=old_current_specializedef;
end;
@ -1279,7 +1302,7 @@ implementation
end;
_RECORD:
begin
def:=record_dec(name);
def:=record_dec(name,genericdef,genericlist);
end;
_PACKED,
_BITPACKED:
@ -1314,7 +1337,7 @@ implementation
def:=object_dec(odt_object,name,genericdef,genericlist,nil);
end;
else
def:=record_dec(name);
def:=record_dec(name,genericdef,genericlist);
end;
current_settings.packrecords:=oldpackrecords;
end;

19
tests/test/tgeneric24.pp Normal file
View File

@ -0,0 +1,19 @@
program project1;
{$mode objfpc}{$H+}
{$apptype console}
type
generic TFoo<T> = record
F: T;
end;
var
FooInt: specialize TFoo<Integer>;
FooStr: specialize TFoo<String>;
begin
FooInt.F := 1;
WriteLn(FooInt.F);
FooStr.F := 'test';
WriteLn(FooStr.F);
end.