paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-18 20:39:43 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: generic function: infer types

Browse Source 
git-svn-id: trunk@43213 -
This commit is contained in:
Mattias Gaertner 2019-10-17 15:00:36 +00:00
parent 700fc43cdf
commit 8a10f0f4b9
2 changed files with 79 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1191,7 +1191,8 @@ const
msArrayOperators,
msPrefixedAttributes,
msOmitRTTI,
msMultiHelpers];
msMultiHelpers,
msImplicitFunctionSpec];
bsAllPas2jsBoolSwitchesReadOnly = [
bsLongStrings
@ -13399,7 +13400,7 @@ begin
begin
P:=TPasElement(El.Declarations[i]);
{$IFDEF VerbosePas2JS}
//writeln('TPasToJSConverter.ConvertDeclarations El[',i,']=',GetObjName(P));
writeln('TPasToJSConverter.ConvertDeclarations El[',i,']=',GetObjName(P));
{$ENDIF}
if not IsElementUsed(P) then continue;

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

@ -42,7 +42,9 @@ type
procedure TestGenProc_Function_ObjFPC;
procedure TestGenProc_Function_Delphi;
procedure TestGenProc_Overload;
// ToDo: inference Fly(3);
procedure TestGenProc_Forward;
procedure TestGenProc_Infer_OverloadForward;
// ToDo: specialize before impl
end;
implementation
@ -716,6 +718,79 @@ begin
'']));
end;
procedure TTestGenerics.TestGenProc_Forward;
begin
StartProgram(false);
Add([
'{$mode delphi}',
'procedure Run<S>(a: S; b: boolean); forward;',
'procedure Run<S>(a: S; b: boolean);',
'begin',
' Run<word>(1,true);',
'end;',
'begin',
' Run(1.3,true);',
'']);
ConvertProgram;
CheckSource('TestGenProc_infer_OverloadForward',
LinesToStr([ // statements
'this.Run$s0 = function (a, b) {',
' $mod.Run$s0(1, true);',
'};',
'this.Run$s1 = function (a, b) {',
' $mod.Run$s0(1, true);',
'};',
'']),
LinesToStr([ // $mod.$main
'$mod.Run$s1(1.3, true);',
'']));
end;
procedure TTestGenerics.TestGenProc_Infer_OverloadForward;
begin
StartProgram(false);
Add([
'{$mode delphi}',
'procedure {#A}Run<S>(a: S; b: boolean); forward; overload;',
'procedure {#B}Run<T>(a: T; w: word); forward; overload;',
'procedure {#C}Run<U>(a: U; b: U); forward; overload;',
'procedure {#A2}Run<S>(a: S; b: boolean); overload;',
'begin',
' {@A}Run(1,true);', // non generic take precedence
' {@B}Run(2,word(3));', // non generic take precedence
' {@C}Run(''foo'',''bar'');',
'end;',
'procedure {#B2}Run<T>(a: T; w: word); overload;',
'begin',
'end;',
'procedure {#C2}Run<U>(a: U; b: U); overload;',
'begin',
'end;',
'begin',
' {@A}Run(1,true);', // non generic take precedence
' {@B}Run(2,word(3));', // non generic take precedence
' {@C}Run(''foo'',''bar'');',
'']);
ConvertProgram;
CheckSource('TestGenProc_infer_OverloadForward',
LinesToStr([ // statements
'this.Run$s0 = function (a, b) {',
' $mod.Run$s0(1, true);',
' $mod.Run$1s0(2, 3);',
' $mod.Run$2s0("foo", "bar");',
'};',
'this.Run$1s0 = function (a, w) {',
'};',
'this.Run$2s0 = function (a, b) {',
'};',
'']),
LinesToStr([ // $mod.$main
'$mod.Run$s0(1, true);',
'$mod.Run$1s0(2, 3);',
'$mod.Run$2s0("foo", "bar");',
'']));
end;
Initialization
RegisterTests([TTestGenerics]);
end.