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

pastojs: test generic methods

Browse Source 
git-svn-id: trunk@43215 -
This commit is contained in:
Mattias Gaertner 2019-10-17 16:24:59 +00:00
parent e28a2b0e21
commit 8872deed26
1 changed files with 60 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -44,6 +44,9 @@ type
procedure TestGenProc_Overload; procedure TestGenProc_Overload;
procedure TestGenProc_Forward; procedure TestGenProc_Forward;
procedure TestGenProc_Infer_OverloadForward; procedure TestGenProc_Infer_OverloadForward;
// generic methods
procedure TestGenMethod_ObjFPC;
end; end;
implementation implementation
@ -790,6 +793,63 @@ begin
''])); '']));
end; end;
procedure TTestGenerics.TestGenMethod_ObjFPC;
begin
StartProgram(false);
Add([
'{$mode objfpc}',
'{$ModeSwitch implicitfunctionspecialization}',
'type',
' TObject = class',
' generic procedure {#A}Run<S>(a: S; b: boolean); overload;',
' generic procedure {#B}Run<T>(a: T; w: word); overload;',
' generic procedure {#C}Run<U>(a: U; b: U); overload;',
' end; ',
'generic procedure {#A2}TObject.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;',
'generic procedure {#B2}TObject.Run<T>(a: T; w: word); overload;',
'begin',
'end;',
'generic procedure {#C2}TObject.Run<U>(a: U; b: U); overload;',
'begin',
'end;',
'var o: TObject;',
'begin',
' o.{@A}Run(1,true);', // non generic take precedence
' o.{@B}Run(2,word(3));', // non generic take precedence
' o.{@C}Run(''foo'',''bar'');',
'']);
ConvertProgram;
CheckSource('TestGenMethod_ObjFPC',
LinesToStr([ // statements
'rtl.createClass($mod, "TObject", null, function () {',
' this.$init = function () {',
' };',
' this.$final = function () {',
' };',
' this.Run$s0 = function (a, b) {',
' this.Run$s0(1, true);',
' this.Run$1s0(2, 3);',
' this.Run$2s0("foo", "bar");',
' };',
' this.Run$1s0 = function (a, w) {',
' };',
' this.Run$2s0 = function (a, b) {',
' };',
'});',
'this.o = null;',
'']),
LinesToStr([ // $mod.$main
'$mod.o.Run$s0(1, true);',
'$mod.o.Run$1s0(2, 3);',
'$mod.o.Run$2s0("foo", "bar");',
'']));
end;
Initialization Initialization
RegisterTests([TTestGenerics]); RegisterTests([TTestGenerics]);
end. end.