From b51c89df41fe84d4b355ce10017bd47092e41aa3 Mon Sep 17 00:00:00 2001
From: Mattias Gaertner <nc-gaertnma@netcologne.de>
Date: Wed, 28 Oct 2020 20:12:17 +0000
Subject: [PATCH] pastojs: fixed a.specialize b<c>

git-svn-id: trunk@47243 -
---
 packages/pastojs/src/fppas2js.pp      | 19 ++++++++---
 packages/pastojs/tests/tcgenerics.pas | 45 +++++++++++++++++++++++++++
 2 files changed, 59 insertions(+), 5 deletions(-)

diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp
index a715ad21ea..948e482788 100644
--- a/packages/pastojs/src/fppas2js.pp
+++ b/packages/pastojs/src/fppas2js.pp
@@ -9405,10 +9405,13 @@ begin
   Result:=nil;
   aResolver:=AContext.Resolver;
 
-  // Note: TPasParser guarantees that there is at most one TBinaryExpr between
+  // Note: TPasParser guarantees that there is at most one TBinaryExpr
+  //       and/or one TInlineSpecializeExpr between
   //       TParamsExpr and its NameExpr. E.g. a.b.c() = ((a.b).c)()
 
   RightEl:=El.right;
+  if RightEl is TInlineSpecializeExpr then
+    RightEl:=TInlineSpecializeExpr(RightEl).NameExpr;
   if (RightEl.ClassType<>TPrimitiveExpr) then
     RaiseNotSupported(RightEl,AContext,20190131162250,'Left='+GetObjName(El.left)+' right='+GetObjName(RightEl));
   if not (RightEl.CustomData is TResolvedReference) then
@@ -9451,10 +9454,13 @@ var
 begin
   aResolver:=AContext.Resolver;
 
-  // Note: TPasParser guarantees that there is at most one TBinaryExpr between
+  // Note: TPasParser guarantees that there is at most one TBinaryExpr
+  //       and/or one TInlineSpecializeExpr between
   //       TParamsExpr and its NameExpr. E.g. a.b.c() = ((a.b).c)()
 
   RightEl:=El.right;
+  if RightEl is TInlineSpecializeExpr then
+    RightEl:=TInlineSpecializeExpr(RightEl).NameExpr;
   if (RightEl.ClassType<>TPrimitiveExpr) then
     begin
     {$IFDEF VerbosePas2JS}
@@ -20826,7 +20832,7 @@ var
   C: TClass;
 begin
   {$IFDEF VerbosePas2JS}
-  writeln('TPasToJSConverter.CreateCallHelperMethod Proc=',GetObjName(Proc),' Expr=',GetObjName(Expr));
+  writeln('TPasToJSConverter.CreateCallHelperMethod Proc=',GetObjName(Proc),' Expr=',GetObjName(Expr),' Implicit=',Implicit);
   {$ENDIF}
   Result:=nil;
   aResolver:=AContext.Resolver;
@@ -24684,9 +24690,12 @@ begin
       if TargetArg.ValueExpr=nil then
         begin
         {$IFDEF VerbosePas2JS}
-        writeln('TPasToJSConverter.CreateProcedureCallArgs missing default value: TargetProc=',TargetProc.Name,' i=',i);
+        writeln('TPasToJSConverter.CreateProcedureCallArgs missing default value: i=',i,' TargetProc=',GetObjPath(TargetProc),' Args=',GetObjPath(Args));
         {$ENDIF}
-        RaiseNotSupported(Args,AContext,20170201193601);
+        if Args=nil then
+          RaiseNotSupported(TargetProc,AContext,20201028203457)
+        else
+          RaiseNotSupported(Args,AContext,20170201193601);
         end;
       AContext.Access:=caRead;
       Arg:=ConvertExpression(TargetArg.ValueExpr,ArgContext);
diff --git a/packages/pastojs/tests/tcgenerics.pas b/packages/pastojs/tests/tcgenerics.pas
index 4ecd7c43bf..6addd26437 100644
--- a/packages/pastojs/tests/tcgenerics.pas
+++ b/packages/pastojs/tests/tcgenerics.pas
@@ -54,6 +54,7 @@ type
     procedure TestGen_ClassInterface_Corba;
     procedure TestGen_ClassInterface_InterfacedObject;
     procedure TestGen_ClassInterface_COM_RTTI;
+    procedure TestGen_ClassInterface_Helper;
 
     // statements
     Procedure TestGen_InlineSpec_Constructor;
@@ -1587,6 +1588,50 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_ClassInterface_Helper;
+begin
+  StartProgram(true,[supTInterfacedObject]);
+  Add([
+  '{$mode objfpc}',
+  '{$ModeSwitch typehelpers}',
+  'type',
+  '  IAnt = interface',
+  '    procedure InterfaceProc;',
+  '  end;',
+  '  TBird = type helper for IAnt',
+  '    generic procedure Fly<T>(a: T);',
+  '  end;',
+  'generic procedure TBird.Fly<T>(a: T);',
+  'begin',
+  'end;',
+  'var ',
+  '  Ant: IAnt;',
+  'begin',
+  '  Ant.specialize Fly<word>(3);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_ClassInterface_COM_RTTI',
+    LinesToStr([ // statements
+    'rtl.createInterface(this, "IAnt", "{B9D0FF27-A446-3A1B-AA85-F167837AA297}", ["InterfaceProc"], pas.system.IUnknown);',
+    'rtl.createHelper(this, "TBird", null, function () {',
+    '  this.Fly$G1 = function (a) {',
+    '  };',
+    '});',
+    'this.Ant = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.TBird.Fly$G1.call({',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.Ant;',
+    '    },',
+    '  set: function (v) {',
+    '      rtl.setIntfP(this.p, "Ant", v);',
+    '    }',
+    '}, 3);',
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_InlineSpec_Constructor;
 begin
   StartProgram(false);