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

pastojs: test generic external class

Browse Source 
git-svn-id: trunk@42664 -
This commit is contained in:
Mattias Gaertner 2019-08-12 19:47:55 +00:00
parent 59e0d334b5
commit bbc542881f
2 changed files with 67 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -12837,6 +12837,8 @@ begin
Result:=ConvertProcedureType(TPasProcedureType(El),GlobalCtx) Result:=ConvertProcedureType(TPasProcedureType(El),GlobalCtx)
else if (C=TPasArrayType) then else if (C=TPasArrayType) then
Result:=ConvertArrayType(TPasArrayType(El),GlobalCtx) Result:=ConvertArrayType(TPasArrayType(El),GlobalCtx)
else if (C=TPasSpecializeType) then
// specialize type is converted at the generic type
else else
begin begin
{$IFDEF VerbosePas2JS} {$IFDEF VerbosePas2JS}

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

@ -14,9 +14,15 @@ type
TTestGenerics = class(TCustomTestModule) TTestGenerics = class(TCustomTestModule)
Published Published
// generic record
Procedure TestGeneric_RecordEmpty; Procedure TestGeneric_RecordEmpty;
// generic class
Procedure TestGeneric_ClassEmpty; Procedure TestGeneric_ClassEmpty;
Procedure TestGeneric_Class_EmptyMethod; Procedure TestGeneric_Class_EmptyMethod;
// generic external class
procedure TestGen_ExtClass_Array;
end; end;
implementation implementation
@ -119,6 +125,65 @@ begin
])); ]));
end; end;
procedure TTestGenerics.TestGen_ExtClass_Array;
begin
StartProgram(false);
Add([
'{$mode delphi}',
'{$ModeSwitch externalclass}',
'type',
' NativeInt = longint;',
' TJSGenArray<T> = Class external name ''Array''',
' private',
' function GetElements(Index: NativeInt): T; external name ''[]'';',
' procedure SetElements(Index: NativeInt; const AValue: T); external name ''[]'';',
' public',
' type TSelfType = TJSGenArray<T>;',
' public',
' FLength : NativeInt; external name ''length'';',
' constructor new; overload;',
' constructor new(aLength : NativeInt); overload;',
' class function _of() : TSelfType; varargs; external name ''of'';',
' function fill(aValue : T) : TSelfType; overload;',
' function fill(aValue : T; aStartIndex : NativeInt) : TSelfType; overload;',
' function fill(aValue : T; aStartIndex,aEndIndex : NativeInt) : TSelfType; overload;',
' property Length : NativeInt Read FLength Write FLength;',
' property Elements[Index: NativeInt]: T read GetElements write SetElements; default;',
' end;',
' TJSWordArray = TJSGenArray<word>;',
'var',
' wa: TJSWordArray;',
' w: word;',
'begin',
' wa:=TJSWordArray.new;',
' wa:=TJSWordArray.new(3);',
' wa:=TJSWordArray._of(4,5);',
' wa:=wa.fill(7);',
' wa:=wa.fill(7,8,9);',
' w:=wa.length;',
' wa.length:=10;',
' wa[11]:=w;',
' w:=wa[12];',
'']);
ConvertProgram;
CheckSource('TestGen_ExtClass_Array',
LinesToStr([ // statements
'this.wa = null;',
'this.w = 0;',
'']),
LinesToStr([ // $mod.$main
'$mod.wa = new Array();',
'$mod.wa = new Array(3);',
'$mod.wa = Array.of(4, 5);',
'$mod.wa = $mod.wa.fill(7);',
'$mod.wa = $mod.wa.fill(7, 8, 9);',
'$mod.w = $mod.wa.length;',
'$mod.wa.length = 10;',
'$mod.wa[11] = $mod.w;',
'$mod.w = $mod.wa[12];',
'']));
end;
Initialization Initialization
RegisterTests([TTestGenerics]); RegisterTests([TTestGenerics]);
end. end.