From 73a2b46263be8d0deac0f9098e2496ce8a5af2f5 Mon Sep 17 00:00:00 2001
From: Mattias Gaertner <nc-gaertnma@netcologne.de>
Date: Fri, 29 May 2020 12:48:42 +0000
Subject: [PATCH] fcl-passrc: specialize varargs of t

git-svn-id: trunk@45526 -
---
 packages/fcl-passrc/src/pasresolver.pp        |  5 +--
 .../fcl-passrc/tests/tcresolvegenerics.pas    | 28 +++++++++++++
 packages/pastojs/tests/tcgenerics.pas         | 40 +++++++++++++++++++
 packages/pastojs/tests/tcmodules.pas          |  4 --
 4 files changed, 70 insertions(+), 7 deletions(-)

diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp
index 0838a3da22..9d262ace92 100644
--- a/packages/fcl-passrc/src/pasresolver.pp
+++ b/packages/fcl-passrc/src/pasresolver.pp
@@ -17524,9 +17524,6 @@ var
   i: Integer;
   GenScope: TPasGenericScope;
 begin
-  if GenEl.VarArgsType<>nil then
-    RaiseNotYetImplemented(20200524214316,GenEl,'specialize varargs of type');
-
   if GenEl.GenericTemplateTypes<>nil then
     begin
     GenScope:=TPasGenericScope(PushScope(SpecEl,TPasProcTypeScope));
@@ -17548,6 +17545,8 @@ begin
     {$IFDEF CheckPasTreeRefCount},'TPasProcedureType.Args'{$ENDIF});
   for i:=0 to SpecEl.Args.Count-1 do
     FinishArgument(TPasArgument(SpecEl.Args[i]));
+  // varargs
+  SpecializeElType(GenEl,SpecEl,GenEl.VarArgsType,SpecEl.VarArgsType);
 
   // calling convention and proc type modifiers
   SpecEl.CallingConvention:=GenEl.CallingConvention;
diff --git a/packages/fcl-passrc/tests/tcresolvegenerics.pas b/packages/fcl-passrc/tests/tcresolvegenerics.pas
index 1e27b74087..e8d5db60e3 100644
--- a/packages/fcl-passrc/tests/tcresolvegenerics.pas
+++ b/packages/fcl-passrc/tests/tcresolvegenerics.pas
@@ -95,6 +95,7 @@ type
 
     // generic external class
     procedure TestGen_ExtClass_Array;
+    procedure TestGen_ExtClass_VarargsOfType;
 
     // generic interface
     procedure TestGen_ClassInterface;
@@ -1561,6 +1562,33 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_ExtClass_VarargsOfType;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSObject = class external name ''Object''',
+  '  end;',
+  '  generic TGJSSet<T> = class external name ''Set''',
+  '    constructor new(aElement1: T); varargs of T; overload;',
+  '    function bind(thisArg: TJSObject): T; varargs of T;',
+  '  end;',
+  '  TJSWordSet = specialize TGJSSet<word>;',
+  'var',
+  '  s: TJSWordSet;',
+  '  w: word;',
+  'begin',
+  '  s:=TJSWordSet.new(3);',
+  '  s:=TJSWordSet.new(3,5);',
+  '  w:=s.bind(nil);',
+  '  w:=s.bind(nil,6);',
+  '  w:=s.bind(nil,7,8);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_ClassInterface;
 begin
   StartProgram(false);
diff --git a/packages/pastojs/tests/tcgenerics.pas b/packages/pastojs/tests/tcgenerics.pas
index 0b78e3db56..27840e93d8 100644
--- a/packages/pastojs/tests/tcgenerics.pas
+++ b/packages/pastojs/tests/tcgenerics.pas
@@ -36,6 +36,7 @@ type
     // ToDo: rename local const T
     Procedure TestGen_Class_TypeCastSpecializesWarn;
     Procedure TestGen_Class_TypeCastSpecializesJSValueNoWarn;
+    procedure TestGen_Class_VarArgsOfType;
 
     // generic external class
     procedure TestGen_ExtClass_Array;
@@ -728,6 +729,45 @@ begin
   CheckResolverUnexpectedHints();
 end;
 
+procedure TTestGenerics.TestGen_Class_VarArgsOfType;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSObject = class external name ''Object''',
+  '  end;',
+  '  generic TGJSSet<T> = class external name ''Set''',
+  '    constructor new(aElement1: T); varargs of T; overload;',
+  '    function bind(thisArg: TJSObject): T; varargs of T;',
+  '  end;',
+  '  TJSWordSet = specialize TGJSSet<word>;',
+  'var',
+  '  s: TJSWordSet;',
+  '  w: word;',
+  'begin',
+  '  s:=TJSWordSet.new(3);',
+  '  s:=TJSWordSet.new(3,5);',
+  '  w:=s.bind(nil);',
+  '  w:=s.bind(nil,6);',
+  '  w:=s.bind(nil,7,8);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_Class_VarArgsOfType',
+    LinesToStr([ // statements
+    'this.s = null;',
+    'this.w = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.s = new Set(3);',
+    '$mod.s = new Set(3, 5);',
+    '$mod.w = $mod.s.bind(null);',
+    '$mod.w = $mod.s.bind(null, 6);',
+    '$mod.w = $mod.s.bind(null, 7, 8);',
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_ExtClass_Array;
 begin
   StartProgram(false);
diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas
index a5eb9b2c3a..5f3f6a9c44 100644
--- a/packages/pastojs/tests/tcmodules.pas
+++ b/packages/pastojs/tests/tcmodules.pas
@@ -874,10 +874,6 @@ type
     Procedure TestAsync_ProcType;
     Procedure TestAsync_ProcTypeAsyncModMismatchFail;
     Procedure TestAsync_Inherited;
-    // ToDo: inherited;
-    // ToDo: inherited asyncproc;
-    // ToDo: await(inherited asyncproc);
-    // ToDo: i:=await(inherited asyncfunc)
   end;
 
 function LinesToStr(Args: array of const): string;