Browse Source

pastojs: rtti of async function: pfAsync

git-svn-id: trunk@49255 -
(cherry picked from commit 1ab2ad3b063e03f1d75d3ff52caf0dfbb6ef6915)
Mattias Gaertner 4 years ago
parent
commit
dff41c209b
2 changed files with 22 additions and 12 deletions
  1. 6 1
      packages/pastojs/src/fppas2js.pp
  2. 16 11
      packages/pastojs/tests/tcmodules.pas

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

@@ -2314,6 +2314,7 @@ type
       pfVarargs = 2;
       pfExternal = 4;
       pfSafeCall = 8;
+      pfAsync = $10;
       // PropertyFlag
       pfGetFunction = 1; // getter is a function
       pfSetProcedure = 2; // setter is a function
@@ -16565,10 +16566,12 @@ begin
       if ResultTypeInfo<>nil then
         InnerCall.AddArg(ResultTypeInfo);
       end;
-    // add param flags
+    // add procedure flags
     Flags:=0;
     if ptmVarargs in El.Modifiers then
       inc(Flags,pfVarargs);
+    if ptmAsync in El.Modifiers then
+      inc(Flags,pfAsync);
     if El.CallingConvention=ccSafeCall then
       inc(Flags,pfSafeCall);
     if Flags>0 then
@@ -20237,6 +20240,8 @@ begin
       inc(Flags,pfStatic);
     if ptmVarargs in Proc.ProcType.Modifiers then
       inc(Flags,pfVarargs);
+    if ptmAsync in Proc.ProcType.Modifiers then
+      inc(Flags,pfAsync);
     if Proc.IsExternal then
       inc(Flags,pfExternal);
     if Flags>0 then

+ 16 - 11
packages/pastojs/tests/tcmodules.pas

@@ -29738,17 +29738,19 @@ procedure TTestModule.TestRTTI_Class_Method;
 begin
   WithTypeInfo:=true;
   StartProgram(false);
-  Add('type');
-  Add('  TObject = class');
-  Add('  private');
-  Add('    procedure Internal; external name ''$intern'';');
-  Add('  published');
-  Add('    procedure Click; virtual; abstract;');
-  Add('    procedure Notify(Sender: TObject); virtual; abstract;');
-  Add('    function GetNotify: boolean; external name ''GetNotify'';');
-  Add('    procedure Println(a,b: longint); varargs; virtual; abstract;');
-  Add('  end;');
-  Add('begin');
+  Add([
+  'type',
+  '  TObject = class',
+  '  private',
+  '    procedure Internal; external name ''$intern'';',
+  '  published',
+  '    procedure Click; virtual; abstract;',
+  '    procedure Notify(Sender: TObject); virtual; abstract;',
+  '    function GetNotify: boolean; external name ''GetNotify'';',
+  '    procedure Println(a,b: longint); varargs; virtual; abstract;',
+  '    function Fetch(URL: string): word; async; external name ''Fetch'';',
+  '  end;',
+  'begin']);
   ConvertProgram;
   CheckSource('TestRTTI_Class_Method',
     LinesToStr([ // statements
@@ -29764,6 +29766,9 @@ begin
     '  $r.addMethod("Println", 0, [["a", rtl.longint], ["b", rtl.longint]], null, {',
     '    flags: 2',
     '  });',
+    '  $r.addMethod("Fetch", 1, [["URL", rtl.string]], rtl.word, {',
+    '    flags: 20',
+    '  });',
     '});',
     '']),
     LinesToStr([ // $mod.$main