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

fcl-passrc: resolver: objfpc: canonical alias to spec record type

Browse Source 
git-svn-id: trunk@43220 -
This commit is contained in:
Mattias Gaertner 2019-10-18 10:37:39 +00:00
parent 8221ff20c3
commit 8323a48e9c
2 changed files with 56 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
packages/fcl-passrc/src/pasresolver.pp
View File

@ -17944,7 +17944,7 @@ end;
procedure TPasResolver.SpecializeRecordType(GenEl, SpecEl: TPasRecordType;
SpecializedItem: TPRSpecializedTypeItem);
var
GenScope: TPasGenericScope;
SpecScope: TPasGenericScope;
begin
SpecEl.PackMode:=GenEl.PackMode;
if SpecializedItem<>nil then
@ -17952,18 +17952,23 @@ begin
// specialized generic record
if SpecEl.CustomData<>nil then
RaiseNotYetImplemented(20190921204740,SpecEl);
GenScope:=TPasGenericScope(PushScope(SpecEl,TPasRecordScope));
GenScope.VisibilityContext:=SpecEl;
GenScope.SpecializedFromItem:=SpecializedItem;
SpecScope:=TPasGenericScope(PushScope(SpecEl,TPasRecordScope));
SpecScope.VisibilityContext:=SpecEl;
SpecScope.SpecializedFromItem:=SpecializedItem;
AddSpecializedTemplateIdentifiers(GenEl.GenericTemplateTypes,
SpecializedItem,GenScope,true);
SpecializedItem,SpecScope,true);
if not (msDelphi in CurrentParser.CurrentModeswitches) then
begin
// ObjFPC: add canonical type alias
SpecScope.AddIdentifier(GenEl.Name,SpecEl,pikSimple);
end;
end
else if GenEl.GenericTemplateTypes.Count>0 then
begin
// generic recordtype inside a generic type
if SpecEl.CustomData=nil then
RaiseNotYetImplemented(20190815201634,SpecEl);
GenScope:=TPasGenericScope(SpecEl.CustomData);
SpecScope:=TPasGenericScope(SpecEl.CustomData);
RaiseNotYetImplemented(20190815194327,GenEl);
end;
// specialize sub elements

45
packages/pastojs/tests/tcgenerics.pas
View File

@ -16,6 +16,9 @@ type
Published
// generic record
Procedure TestGen_RecordEmpty;
Procedure TestGen_Record_ClassProc_ObjFPC;
//Procedure TestGen_Record_ClassProc_Delphi;
//Procedure TestGen_Record_ReferGenClass_DelphiFail;
// generic class
Procedure TestGen_ClassEmpty;
@ -87,6 +90,48 @@ begin
]));
end;
procedure TTestGenerics.TestGen_Record_ClassProc_ObjFPC;
begin
StartProgram(false);
Add([
'{$modeswitch AdvancedRecords}',
'type',
' generic TPoint<T> = record',
' class var x: T;',
' class procedure Fly; static;',
' end;',
'class procedure Tpoint.Fly;',
'begin',
//' x:=x+3;',
' tpoint.x:=tpoint.x+4;',
//' Fly;',
' tpoint.Fly;',
'end;',
'var p: specialize TPoint<word>;',
'begin',
'']);
ConvertProgram;
CheckSource('TestGen_Record_ClassProc',
LinesToStr([ // statements
'rtl.recNewT($mod, "TPoint$G1", function () {',
' this.x = 0;',
' this.$eq = function (b) {',
' return true;',
' };',
' this.$assign = function (s) {',
' return this;',
' };',
' this.Fly = function () {',
' $mod.TPoint$G1.x = $mod.TPoint$G1.x + 4;',
' $mod.TPoint$G1.Fly();',
' };',
'}, true);',
'this.p = $mod.TPoint$G1.$new();',
'']),
LinesToStr([ // $mod.$main
'']));
end;
procedure TTestGenerics.TestGen_ClassEmpty;
begin
StartProgram(false);