pas2js: async procedure modifier

git-svn-id: trunk@45435 -

packages/pastojs/src/fppas2js.pp

@@ -1238,7 +1238,8 @@ const
     po_AsmWhole,
     po_ResolveStandardTypes,
     po_ExtConstWithoutExpr,
-    po_StopOnUnitInterface];
+    po_StopOnUnitInterface,
+    po_AsyncProcs];
 
   btAllJSBaseTypes = [
     btChar,
@@ -4087,7 +4088,8 @@ begin
       if (not (pm in [pmVirtual, pmAbstract, pmOverride,
                       pmOverload, pmMessage, pmReintroduce,
                       pmInline, pmAssembler, pmPublic,
-                      pmExternal, pmForward])) then
+                      pmExternal, pmForward,
+                      pmAsync])) then
         RaiseNotYetImplemented(20170208142159,El,'modifier '+ModifierNames[pm]);
     for ptm in Proc.ProcType.Modifiers do
       if (not (ptm in [ptmOfObject,ptmVarargs,ptmStatic])) then
@@ -4234,7 +4236,7 @@ begin
         RaiseMsg(20170227095454,nMissingExternalName,sMissingExternalName,
           ['missing external name'],Proc);
 
-      for pm in [pmAssembler,pmForward,pmNoReturn,pmInline] do
+      for pm in [pmAssembler,pmForward,pmNoReturn,pmInline,pmAsync] do
         if pm in Proc.Modifiers then
           RaiseMsg(20170323100842,nInvalidXModifierY,sInvalidXModifierY,
             [Proc.ElementTypeName,ModifierNames[pm]],Proc);
@@ -15052,6 +15054,7 @@ begin
 
   FS:=CreateFunctionSt(ImplProc,ImplProc.Body<>nil);
   FD:=FS.AFunction;
+  FD.IsAsync:=El.IsAsync or ImplProc.IsAsync;
   if AssignSt<>nil then
     AssignSt.Expr:=FS
   else

packages/pastojs/src/pas2jsfiler.pp

@@ -132,7 +132,8 @@ const
     'StopOnErrorDirective',
     'ExtClassConstWithoutExpr',
     'StopOnUnitInterface',
-    'IgnoreUnknownResource');
+    'IgnoreUnknownResource',
+    'AsyncProcs');
 
   PCUDefaultModeSwitches: TModeSwitches = [
     msObjfpc,
@@ -486,7 +487,8 @@ const
     'DispId',
     'NoReturn',
     'Far',
-    'Final'
+    'Final',
+    'Async'
     );
   PCUProcedureModifiersImplProc = [pmInline,pmAssembler,pmCompilerProc,pmNoReturn];
 

packages/pastojs/tests/tcmodules.pas

@@ -340,6 +340,7 @@ type
     Procedure TestProc_LocalVarInit;
     Procedure TestProc_ReservedWords;
     Procedure TestProc_ConstRefWord;
+    Procedure TestProc_Async;
 
     // anonymous functions
     Procedure TestAnonymousProc_Assign_ObjFPC;
@@ -352,6 +353,7 @@ type
     Procedure TestAnonymousProc_NestedAssignResult;
     Procedure TestAnonymousProc_Class;
     Procedure TestAnonymousProc_ForLoop;
+    Procedure TestAnonymousProc_Async;
 
     // enums, sets
     Procedure TestEnum_Name;
@@ -4604,6 +4606,32 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestProc_Async;
+begin
+  StartProgram(false);
+  Add([
+  'procedure Fly(w: word); async; forward;',
+  'procedure Run(w: word); async;',
+  'begin',
+  'end;',
+  'procedure Fly(w: word); ',
+  'begin',
+  'end;',
+  'begin',
+  '  Run(1);']);
+  ConvertProgram;
+  CheckSource('TestProc_Async',
+    LinesToStr([ // statements
+    'this.Run = async function (w) {',
+    '};',
+    'this.Fly = async function (w) {',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.Run(1);'
+    ]));
+end;
+
 procedure TTestModule.TestAnonymousProc_Assign_ObjFPC;
 begin
   StartProgram(false);
@@ -5083,6 +5111,35 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestAnonymousProc_Async;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TFunc = reference to function(x: word): word;',
+  'var Func: TFunc;',
+  'begin',
+  '  Func:=function(c:word):word async begin',
+  '  end;',
+  '  Func:=function(c:word):word async assembler asm',
+  '  end;',
+  '  ']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_Async',
+    LinesToStr([ // statements
+    'this.Func = null;',
+    '']),
+    LinesToStr([
+    '$mod.Func = async function (c) {',
+    '  var Result = 0;',
+    '  return Result;',
+    '};',
+    '$mod.Func = async function (c) {',
+    '};',
+    '']));
+end;
+
 procedure TTestModule.TestEnum_Name;
 begin
   StartProgram(false);