浏览代码

fcl-passrc: resolver: fixed typecast a(b.func) marking implicit call

git-svn-id: trunk@47914 -
Mattias Gaertner 4 年之前
父节点
当前提交
7032cba91e
共有 2 个文件被更改,包括 47 次插入1 次删除
  1. 1 1
      packages/fcl-passrc/src/pasresolver.pp
  2. 46 0
      packages/pastojs/tests/tcgenerics.pas

+ 1 - 1
packages/fcl-passrc/src/pasresolver.pp

@@ -13938,7 +13938,7 @@ begin
       begin
       // type cast
       Param0:=Params.Params[0];
-      ComputeElement(Param0,ParamResolved,[]);
+      ComputeElement(Param0,ParamResolved,Flags);
       ComputeTypeCast(ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,Param0,
                       ParamResolved,ResolvedEl,Flags);
       end

+ 46 - 0
packages/pastojs/tests/tcgenerics.pas

@@ -83,6 +83,7 @@ type
     // generic array
     procedure TestGen_Array_OtherUnit;
     procedure TestGen_ArrayOfUnitImplRec;
+    procedure TestGen_Array_TypecastJSValueResultToArg;
 
     // generic procedure type
     procedure TestGen_ProcType_ProcLocal;
@@ -2373,6 +2374,51 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_Array_TypecastJSValueResultToArg;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TArray<T> = array of T;',
+  '  TFunc = function: JSValue of object;',
+  '  TObject = class',
+  '    f: TFunc;',
+  '    function Run: jsvalue; virtual; abstract;',
+  '  end;',
+  'procedure Sit(Arr: TArray<TObject>);',
+  'begin',
+  'end;',
+  'procedure Fly(o: TObject);',
+  'begin',
+  '  Sit(TArray<TObject>(o.f()));',
+  '  Sit(TArray<TObject>(o.Run));',
+  '  Sit(TArray<TObject>(o.Run()));',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestGen_Array_TypecastJSValueResultToArg',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.f = null;',
+    '  };',
+    '  this.$final = function () {',
+    '    this.f = undefined;',
+    '  };',
+    '});',
+    'this.Sit = function (Arr) {',
+    '};',
+    'this.Fly = function (o) {',
+    '  $mod.Sit(o.f());',
+    '  $mod.Sit(o.Run());',
+    '  $mod.Sit(o.Run());',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_ProcType_ProcLocal;
 begin
   StartProgram(false);