paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 10:19:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: rtti of async function: pfAsync

Browse Source 
git-svn-id: trunk@49255 -
(cherry picked from commit 1ab2ad3b06)
This commit is contained in:
Mattias Gaertner 2021-04-24 12:04:37 +00:00 committed by Florian Klämpfl
parent 6f64bed140
commit dff41c209b
2 changed files with 22 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
packages/pastojs/src/fppas2js.pp
View File

@ -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

27
packages/pastojs/tests/tcmodules.pas
View File

@ -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