Browse Source

pas2js: async proc type

git-svn-id: trunk@45517 -
Mattias Gaertner 5 years ago
parent
commit
b6e2a228d3

+ 12 - 1
packages/pastojs/src/fppas2js.pp

@@ -5460,6 +5460,8 @@ var
   Param, PathEnd: TPasExpr;
   Ref: TResolvedReference;
   Decl: TPasElement;
+  ResolvedEl: TPasResolverResult;
+  Implicit: Boolean;
 begin
   if Proc=nil then ;
   P:=Params.Params;
@@ -5472,10 +5474,19 @@ begin
     PathEnd:=GetPathEndIdent(Param,false);
     if (PathEnd<>nil) and (PathEnd.CustomData is TResolvedReference) then
       begin
+      // await(a.b)
       Ref:=TResolvedReference(PathEnd.CustomData);
       Decl:=Ref.Declaration;
-      if Decl is TPasProcedure then
+      Implicit:=false;
+      if Decl is TPasVariable then
         begin
+        ComputeElement(Decl,ResolvedEl,[rcNoImplicitProcType]);
+        if IsProcedureType(ResolvedEl,true) then
+          Implicit:=true;
+        end
+      else if (Decl is TPasProcedure) then
+        Implicit:=true;
+      if Implicit then begin
         // implicit call
         Exclude(Ref.Flags,rrfNoImplicitCallWithoutParams);
         Include(Ref.Flags,rrfImplicitCallWithoutParams);

+ 4 - 1
packages/pastojs/src/pas2jsfiler.pp

@@ -383,7 +383,10 @@ const
     'ClassHelper',
     'RecordHelper',
     'TypeHelper',
-    'DispInterface'
+    'DispInterface',
+    'ObjcClass',
+    'ObjcCategory',
+    'ObjcProtocol'
     );
 
   PCUClassInterfaceTypeNames: array[TPasClassInterfaceType] of string = (

+ 74 - 2
packages/pastojs/tests/tcmodules.pas

@@ -871,6 +871,7 @@ type
     Procedure TestAWait_Result;
     Procedure TestAWait_ExternalClassPromise;
     Procedure TestAsync_AnonymousProc;
+    Procedure TestAsync_ProcType;
     // ToDo: proc type, implict call, explicit call, await()
     // ToDo: proc type assign async mismatch fail
     // ToDo: inherited;
@@ -31908,10 +31909,14 @@ procedure TTestModule.TestAsync_AnonymousProc;
 begin
   StartProgram(false);
   Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSPromise = class external name ''Promise''',
+  '  end;',
   '{$mode objfpc}',
   'type',
   '  TFunc = reference to function(x: double): word; async;',
-  'function Crawl(d: double = 1.3): word; ',
+  'function Crawl(d: double = 1.3): word; async;',
   'begin',
   'end;',
   'var Func: TFunc;',
@@ -31925,7 +31930,7 @@ begin
   ConvertProgram;
   CheckSource('TestAsync_AnonymousProc',
     LinesToStr([ // statements
-    'this.Crawl = function (d) {',
+    'this.Crawl = async function (d) {',
     '  var Result = 0;',
     '  return Result;',
     '};',
@@ -31942,6 +31947,73 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestAsync_ProcType;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TRefFunc = reference to function(x: double = 1.3): word; async;',
+  '  TFunc = function(x: double = 1.1): word; async;',
+  '  TProc = procedure(x: longint = 7); async;',
+  'function Crawl(d: double): word; async;',
+  'begin',
+  'end;',
+  'procedure Run(e:longint); async;',
+  'begin',
+  'end;',
+  'var',
+  '  RefFunc: TRefFunc;',
+  '  Func: TFunc;',
+  '  Proc, ProcB: TProc;',
+  'begin',
+  '  Func:=@Crawl;',
+  '  RefFunc:=@Crawl;',
+  '  RefFunc:=function(c:double):word async begin',
+  '    Result:=await(RefFunc);',
+  '    Result:=await(RefFunc());',
+  '    Result:=await(Func);',
+  '    Result:=await(Func());',
+  '    await(Proc);',
+  '    await(Proc());',
+  '    await(Proc(13));',
+  '  end;',
+  '  Proc:=@Run;',
+  '  if Proc=ProcB then ;',
+  '  ']);
+  ConvertProgram;
+  CheckSource('TestAsync_ProcType',
+    LinesToStr([ // statements
+    'this.Crawl = async function (d) {',
+    '  var Result = 0;',
+    '  return Result;',
+    '};',
+    'this.Run = async function (e) {',
+    '};',
+    'this.RefFunc = null;',
+    'this.Func = null;',
+    'this.Proc = null;',
+    'this.ProcB = null;',
+    '']),
+    LinesToStr([
+    '$mod.Func = $mod.Crawl;',
+    '$mod.RefFunc = $mod.Crawl;',
+    '$mod.RefFunc = async function (c) {',
+    '  var Result = 0;',
+    '  Result = await $mod.RefFunc(1.3);',
+    '  Result = await $mod.RefFunc(1.3);',
+    '  Result = await $mod.Func(1.1);',
+    '  Result = await $mod.Func(1.1);',
+    '  await $mod.Proc(7);',
+    '  await $mod.Proc(7);',
+    '  await $mod.Proc(13);',
+    '  return Result;',
+    '};',
+    '$mod.Proc = $mod.Run;',
+    'if (rtl.eqCallback($mod.Proc, $mod.ProcB)) ;',
+    '']));
+end;
+
 
 Initialization
   RegisterTests([TTestModule]);