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

pastojs: generic procedure overload

Browse Source 
git-svn-id: trunk@43210 -
This commit is contained in:
Mattias Gaertner 2019-10-16 16:24:11 +00:00
parent 7fa2ac9420
commit bb4402b2a4
2 changed files with 167 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
packages/pastojs/src/fppas2js.pp
View File

@ -2832,6 +2832,8 @@ begin
if ProcScope.DeclarationProc<>nil then
// implementation proc -> only count the header -> skip
exit(false);
if ProcScope.SpecializedFromItem<>nil then
exit(false);
end;
Result:=true;
end;
@ -5792,12 +5794,30 @@ end;
function TPas2JSResolver.GetOverloadName(El: TPasElement): string;
var
Data: TObject;
ProcScope, GenScope: TPas2JSProcedureScope;
GenEl: TPasElement;
begin
Data:=El.CustomData;
if Data is TPas2JSProcedureScope then
begin
Result:=TPas2JSProcedureScope(Data).OverloadName;
if Result<>'' then exit;
ProcScope:=TPas2JSProcedureScope(Data);
if ProcScope.SpecializedFromItem<>nil then
begin
// specialized proc -> generic name + 's' + index
GenEl:=ProcScope.SpecializedFromItem.GenericEl;
GenScope:=TPas2JSProcedureScope(GenEl.CustomData);
Result:=GenScope.OverloadName;
if Result='' then
Result:=GenEl.Name+'$';
Result:=Result+'s'+IntToStr(ProcScope.SpecializedFromItem.Index);
end
else
begin
Result:=ProcScope.OverloadName;
if Result='' then
Result:=El.Name;
end;
exit;
end;
Result:=El.Name;
end;
@ -14644,11 +14664,12 @@ begin
exit;
IsClassConDestructor:=(El.ClassType=TPasClassConstructor)
or (El.ClassType=TPasClassDestructor);
aResolver:=AContext.Resolver;
if not aResolver.IsFullySpecialized(El) then exit;
{$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.ConvertProcedure "',El.Name,'" Overload="',ProcScope.OverloadName,'" ',El.Parent.ClassName);
{$ENDIF}
aResolver:=AContext.Resolver;
ImplProc:=El;
if ProcScope.ImplProc<>nil then

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

@ -34,14 +34,14 @@ type
Procedure TestGen_CallUnitImplProc;
Procedure TestGen_IntAssignTemplVar;
Procedure TestGen_TypeCastDotField;
// ToDo: TBird<word>(o).field:=3;
// generic helper
// ToDo: helper for gen array: TArray<word>.Fly(aword);
procedure TestGen_HelperForArray;
// generic functions
// ToDo: Fly<word>(3);
// ToDo: TestGenProc_ProcT
procedure TestGenProc_Function_ObjFPC;
procedure TestGenProc_Function_Delphi;
procedure TestGenProc_Overload;
// ToDo: inference Fly(3);
end;
@ -577,6 +577,145 @@ begin
'']));
end;
procedure TTestGenerics.TestGen_HelperForArray;
begin
StartProgram(false);
Add([
'{$ModeSwitch typehelpers}',
'type',
' generic TArr<T> = array[1..2] of T;',
' TWordArrHelper = type helper for specialize TArr<word>',
' procedure Fly(w: word);',
' end;',
'procedure TWordArrHelper.Fly(w: word);',
'begin',
'end;',
'var',
' a: specialize TArr<word>;',
'begin',
' a.Fly(3);',
'']);
ConvertProgram;
CheckSource('TestGen_HelperForArray',
LinesToStr([ // statements
'rtl.createHelper($mod, "TWordArrHelper", null, function () {',
' this.Fly = function (w) {',
' };',
'});',
'this.a = rtl.arraySetLength(null, 0, 2);',
'']),
LinesToStr([ // $mod.$main
'$mod.TWordArrHelper.Fly.call({',
' p: $mod,',
' get: function () {',
' return this.p.a;',
' },',
' set: function (v) {',
' this.p.a = v;',
' }',
'}, 3);',
'']));
end;
procedure TTestGenerics.TestGenProc_Function_ObjFPC;
begin
StartProgram(false);
Add([
'generic function Run<T>(a: T): T;',
'var i: T;',
'begin',
' a:=i;',
' Result:=a;',
'end;',
'var w: word;',
'begin',
' w:=specialize Run<word>(3);',
'']);
ConvertProgram;
CheckSource('TestGenProc_Function_ObjFPC',
LinesToStr([ // statements
'this.Run$s0 = function (a) {',
' var Result = 0;',
' var i = 0;',
' a = i;',
' Result = a;',
' return Result;',
'};',
'this.w = 0;',
'']),
LinesToStr([ // $mod.$main
'$mod.w = $mod.Run$s0(3);',
'']));
end;
procedure TTestGenerics.TestGenProc_Function_Delphi;
begin
StartProgram(false);
Add([
'{$mode delphi}',
'function Run<T>(a: T): T;',
'var i: T;',
'begin',
' a:=i;',
' Result:=a;',
'end;',
'var w: word;',
'begin',
' w:=Run<word>(3);',
'']);
ConvertProgram;
CheckSource('TestGenProc_Function_Delphi',
LinesToStr([ // statements
'this.Run$s0 = function (a) {',
' var Result = 0;',
' var i = 0;',
' a = i;',
' Result = a;',
' return Result;',
'};',
'this.w = 0;',
'']),
LinesToStr([ // $mod.$main
'$mod.w = $mod.Run$s0(3);',
'']));
end;
procedure TTestGenerics.TestGenProc_Overload;
begin
StartProgram(false);
Add([
'generic procedure DoIt<T>(a: T; w: word); overload;',
'begin',
'end;',
'generic procedure DoIt<T>(a: T; b: boolean); overload;',
'begin',
'end;',
'begin',
' specialize DoIt<word>(3,4);',
' specialize DoIt<boolean>(false,5);',
' specialize DoIt<word>(6,true);',
' specialize DoIt<double>(7.3,true);',
'']);
ConvertProgram;
CheckSource('TestGenProc_Overload',
LinesToStr([ // statements
'this.DoIt$s0 = function (a, w) {',
'};',
'this.DoIt$s1 = function (a, w) {',
'};',
'this.DoIt$1s0 = function (a, b) {',
'};',
'this.DoIt$1s1 = function (a, b) {',
'};',
'']),
LinesToStr([ // $mod.$main
'$mod.DoIt$s0(3, 4);',
'$mod.DoIt$s1(false, 5);',
'$mod.DoIt$1s0(6, true);',
'$mod.DoIt$1s1(7.3, true);',
'']));
end;
Initialization
RegisterTests([TTestGenerics]);
end.