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

pas2js: async procedure modifier

Browse Source 
git-svn-id: trunk@45435 -
This commit is contained in:
Mattias Gaertner 2020-05-19 12:44:11 +00:00
parent d9734aa533
commit a501be1b2b
3 changed files with 67 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

6
packages/pastojs/src/pas2jsfiler.pp
View File

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

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

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