paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-19 03:09:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

compiler: specialize record methods the same way as currently done for object and class methods + test

Browse Source 
git-svn-id: trunk@16726 -
This commit is contained in:
paul 2011-01-07 16:57:21 +00:00
parent 24813219da
commit f5965a9ce4
3 changed files with 27 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -9427,6 +9427,7 @@ tests/test/tgeneric30.pp svneol=native#text/pascal
tests/test/tgeneric31.pp svneol=native#text/pascal tests/test/tgeneric31.pp svneol=native#text/pascal
tests/test/tgeneric32.pp svneol=native#text/pascal tests/test/tgeneric32.pp svneol=native#text/pascal
tests/test/tgeneric33.pp svneol=native#text/pascal tests/test/tgeneric33.pp svneol=native#text/pascal
tests/test/tgeneric34.pp svneol=native#text/pascal
tests/test/tgeneric4.pp svneol=native#text/plain tests/test/tgeneric4.pp svneol=native#text/plain
tests/test/tgeneric5.pp svneol=native#text/plain tests/test/tgeneric5.pp svneol=native#text/plain
tests/test/tgeneric6.pp svneol=native#text/plain tests/test/tgeneric6.pp svneol=native#text/plain

10
compiler/psub.pas
View File

@ -1984,20 +1984,20 @@ implementation
oldsymtablestack : tsymtablestack; oldsymtablestack : tsymtablestack;
pu : tused_unit; pu : tused_unit;
hmodule : tmodule; hmodule : tmodule;
specobj : tobjectdef; specobj : tabstractrecorddef;
begin begin
if not((tsym(p).typ=typesym) and if not((tsym(p).typ=typesym) and
(ttypesym(p).typedef.typesym=tsym(p)) and (ttypesym(p).typedef.typesym=tsym(p)) and
(ttypesym(p).typedef.typ=objectdef) and (ttypesym(p).typedef.typ in [objectdef,recorddef]) and
(df_specialization in ttypesym(p).typedef.defoptions) (df_specialization in ttypesym(p).typedef.defoptions)
) then ) then
exit; exit;
{ Setup symtablestack a definition time } { Setup symtablestack a definition time }
specobj:=tobjectdef(ttypesym(p).typedef); specobj:=tabstractrecorddef(ttypesym(p).typedef);
oldsymtablestack:=symtablestack; oldsymtablestack:=symtablestack;
symtablestack:=tsymtablestack.create; symtablestack:=tsymtablestack.create;
if not assigned(tobjectdef(ttypesym(p).typedef).genericdef) then if not assigned(specobj.genericdef) then
internalerror(200705151); internalerror(200705151);
hmodule:=find_module_from_symtable(specobj.genericdef.owner); hmodule:=find_module_from_symtable(specobj.genericdef.owner);
if hmodule=nil then if hmodule=nil then
@ -2016,7 +2016,7 @@ implementation
symtablestack.push(hmodule.localsymtable); symtablestack.push(hmodule.localsymtable);
{ procedure definitions for classes or objects } { procedure definitions for classes or objects }
if is_class_or_object(specobj) then if is_class_or_object(specobj) or is_record(specobj) then
begin begin
for i:=0 to specobj.symtable.DefList.Count-1 do for i:=0 to specobj.symtable.DefList.Count-1 do
begin begin

21
tests/test/tgeneric34.pp Normal file
View File

@ -0,0 +1,21 @@
program tgeneric34;
{$mode delphi}
type
TFoo<T> = record
function DoSomething(Arg: T): T;
end;
function TFoo<T>.DoSomething(Arg: T): T;
begin
Result := Arg;
end;
var
FooInt: TFoo<Integer>;
begin
if FooInt.DoSomething(1) <> 1 then
halt(1);
end.