From c30568930550219bbd34698bb4f5e97a53df048e Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Tue, 26 May 2020 08:48:14 +0000 Subject: [PATCH] pas2js: calling async function returns promise, await(async proc); git-svn-id: trunk@45506 - --- packages/pastojs/src/fppas2js.pp | 235 ++++++++++++- packages/pastojs/src/pas2jsfiler.pp | 6 +- packages/pastojs/tests/tcmodules.pas | 499 +++++++++++++++++++-------- 3 files changed, 572 insertions(+), 168 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 5db1678bc3..adea811bf8 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -1094,11 +1094,22 @@ type end; TPas2JsElementDataClass = class of TPas2JsElementData; + TPas2JSModuleScopeFlag = ( + p2msfPromiseSearched // TJSPromise searched + ); + TPas2JSModuleScopeFlags = set of TPas2JSModuleScopeFlag; + { TPas2JSModuleScope } TPas2JSModuleScope = class(TPasModuleScope) + private + FJSPromiseClass: TPasClassType; + procedure SetJSPromiseClass(const AValue: TPasClassType); public + FlagsJS: TPas2JSModuleScopeFlags; SystemVarRecs: TPasFunction; + destructor Destroy; override; + property JSPromiseClass: TPasClassType read FJSPromiseClass write SetJSPromiseClass; end; { TPas2jsElevatedLocals } @@ -1334,6 +1345,18 @@ type end; PHasAnoFuncData = ^THasAnoFuncData; procedure OnHasAnonymousEl(El: TPasElement; arg: pointer); + protected + type + TPRFindExtSystemClass = record + JSName: string; + ErrorPosEl: TPasElement; + Found: TPasClassType; + ElScope: TPasScope; // Where Found was found + StartScope: TPasScope; // where the search started + end; + PPRFindExtSystemClass = ^TPRFindExtSystemClass; + procedure OnFindExtSystemClass(El: TPasElement; ElScope, StartScope: TPasScope; + FindExtSystemClassData: Pointer; var Abort: boolean); virtual; protected // overloads: fix name clashes in JS FOverloadScopes: TFPList; // list of TPasIdentifierScope @@ -1381,6 +1404,9 @@ type ); override; procedure FindCreatorArrayOfConst(Args: TFPList; ErrorEl: TPasElement); function FindProc_ArrLitToArrayOfConst(ErrorEl: TPasElement): TPasFunction; virtual; + function FindSystemExternalClassType(const aClassName, JSName: string; + ErrorEl: TPasElement): TPasClassType; virtual; + function FindTJSPromise(ErrorEl: TPasElement): TPasClassType; virtual; procedure CheckExternalClassConstructor(Ref: TResolvedReference); virtual; procedure CheckConditionExpr(El: TPasExpr; const ResolvedEl: TPasResolverResult); override; @@ -1425,6 +1451,8 @@ type Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual; procedure BI_AWait_OnEval(Proc: TResElDataBuiltInProc; Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual; + procedure BI_AWait_OnFinishParamsExpr(Proc: TResElDataBuiltInProc; + Params: TParamsExpr); virtual; public constructor Create; reintroduce; destructor Destroy; override; @@ -1456,6 +1484,9 @@ type procedure CheckDispatchField(Proc: TPasProcedure; Switch: TValueSwitch); procedure AddMessageStr(var MsgToProc: TMessageIdToProc_List; const S: string; Proc: TPasProcedure); procedure AddMessageIdToClassScope(Proc: TPasProcedure; EmitHints: boolean); virtual; + procedure ComputeResultElement(El: TPasResultElement; out + ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags; + StartEl: TPasElement = nil); override; // CustomData function GetElementData(El: TPasElementBase; DataClass: TPas2JsElementDataClass): TPas2JsElementData; virtual; @@ -2223,6 +2254,24 @@ begin Result:='['+Result+']'; end; +{ TPas2JSModuleScope } + +procedure TPas2JSModuleScope.SetJSPromiseClass(const AValue: TPasClassType); +begin + if FJSPromiseClass=AValue then Exit; + if FJSPromiseClass<>nil then + FJSPromiseClass.Release{$IFDEF CheckPasTreeRefCount}('TPas2JSModuleScope.SetJSPromiseClass'){$ENDIF}; + FJSPromiseClass:=AValue; + if FJSPromiseClass<>nil then + FJSPromiseClass.AddRef{$IFDEF CheckPasTreeRefCount}('TPas2JSModuleScope.SetJSPromiseClass'){$ENDIF}; +end; + +destructor TPas2JSModuleScope.Destroy; +begin + JSPromiseClass:=nil; + inherited Destroy; +end; + { TPas2JSClassScope } constructor TPas2JSClassScope.Create; @@ -2846,6 +2895,25 @@ begin Data^.Expr:=TProcedureExpr(El); end; +procedure TPas2JSResolver.OnFindExtSystemClass(El: TPasElement; ElScope, + StartScope: TPasScope; FindExtSystemClassData: Pointer; var Abort: boolean); +var + Data: PPRFindExtSystemClass absolute FindExtSystemClassData; + aClass: TPasClassType; +begin + if Data^.Found<>nil then exit; + if not (El is TPasClassType) then exit; + aClass:=TPasClassType(El); + if not aClass.IsExternal then exit; + if aClass.Parent is TPasMembersType then + exit; // nested class + if not IsExternalClass_Name(aClass,Data^.JSName) then exit; + Data^.Found:=aClass; + Data^.ElScope:=ElScope; + Data^.StartScope:=StartScope; + Abort:=true; +end; + function TPas2JSResolver.HasOverloadIndex(El: TPasElement; WithElevatedLocal: boolean): boolean; var @@ -4098,11 +4166,10 @@ begin if (not (pm in [pmVirtual, pmAbstract, pmOverride, pmOverload, pmMessage, pmReintroduce, pmInline, pmAssembler, pmPublic, - pmExternal, pmForward, - pmAsync])) then + pmExternal, pmForward])) then RaiseNotYetImplemented(20170208142159,El,'modifier '+ModifierNames[pm]); for ptm in Proc.ProcType.Modifiers do - if (not (ptm in [ptmOfObject,ptmVarargs,ptmStatic])) then + if (not (ptm in [ptmOfObject,ptmVarargs,ptmStatic,ptmAsync])) then RaiseNotYetImplemented(20170411171454,El,'modifier '+ProcTypeModifiers[ptm]); // check pmPublic @@ -4184,7 +4251,8 @@ begin and (Proc.ClassType=TPasClassFunction) and (Proc.Visibility in [visProtected,visPublic,visPublished]) and (TPasClassFunction(Proc).FuncType.ResultEl.ResultType=AClassOrRec) - and ([pmOverride,pmExternal]*Proc.Modifiers=[]) then + and (Proc.Modifiers*[pmOverride,pmExternal]=[]) + and (Proc.ProcType.Modifiers*[ptmOfObject]=[ptmOfObject]) then begin // The first non private class function in a Pascal class descending // from an external class @@ -4246,7 +4314,7 @@ begin RaiseMsg(20170227095454,nMissingExternalName,sMissingExternalName, ['missing external name'],Proc); - for pm in [pmAssembler,pmForward,pmNoReturn,pmInline,pmAsync] do + for pm in [pmAssembler,pmForward,pmNoReturn,pmInline] do if pm in Proc.Modifiers then RaiseMsg(20170323100842,nInvalidXModifierY,sInvalidXModifierY, [Proc.ElementTypeName,ModifierNames[pm]],Proc); @@ -4429,6 +4497,37 @@ begin cCallingConventions[FuncType.CallingConvention],ErrorEl); end; +function TPas2JSResolver.FindSystemExternalClassType(const aClassName, + JSName: string; ErrorEl: TPasElement): TPasClassType; +var + Data: TPRFindExtSystemClass; + Abort: boolean; +begin + Data:=Default(TPRFindExtSystemClass); + Data.ErrorPosEl:=ErrorEl; + Data.JSName:=JSName; + Abort:=false; + IterateElements(aClassName,@OnFindExtSystemClass,@Data,Abort); + Result:=Data.Found; + if (ErrorEl<>nil) and (Result=nil) then + RaiseIdentifierNotFound(20200526095647,aClassName+' = class external name '''+JSName+'''',ErrorEl); +end; + +function TPas2JSResolver.FindTJSPromise(ErrorEl: TPasElement): TPasClassType; +var + aMod: TPasModule; + ModScope: TPas2JSModuleScope; +begin + aMod:=RootElement; + ModScope:=aMod.CustomData as TPas2JSModuleScope; + Result:=ModScope.JSPromiseClass; + if p2msfPromiseSearched in ModScope.FlagsJS then + exit; // use cache + Result:=FindSystemExternalClassType('TJSPromise','Promise',ErrorEl); + ModScope.JSPromiseClass:=Result; + Include(ModScope.FlagsJS,p2msfPromiseSearched); +end; + procedure TPas2JSResolver.CheckExternalClassConstructor(Ref: TResolvedReference ); var @@ -5013,6 +5112,7 @@ var TemplType: TPasGenericTemplateType; ConEl: TPasElement; ConToken: TToken; + ResultEl: TPasResultElement; begin Param:=Params.Params[0]; ComputeElement(Param,ParamResolved,[rcNoImplicitProc]); @@ -5021,8 +5121,8 @@ begin if (ParamResolved.BaseType=btProc) and (ParamResolved.IdentEl is TPasFunction) then begin // typeinfo of function result -> resolve once - TypeEl:=TPasFunction(ParamResolved.IdentEl).FuncType.ResultEl.ResultType; - ComputeElement(TypeEl,ParamResolved,[rcNoImplicitProc]); + ResultEl:=TPasFunction(ParamResolved.IdentEl).FuncType.ResultEl; + ComputeResultElement(ResultEl,ParamResolved,[]); Include(ParamResolved.Flags,rrfReadable); if ParamResolved.LoTypeEl=nil then RaiseInternalError(20170421124923); @@ -5211,7 +5311,9 @@ end; function TPas2JSResolver.BI_AWait_OnGetCallCompatibility( Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer; -// function await(const Expr: T): T +// await(const Expr: T): T +// await(T; p: TJSPromise): T; +// await(AsyncProc); const Signature2 = 'function await(aType,TJSPromise):aType'; var @@ -5242,6 +5344,18 @@ begin // function await(value) // must be the only parameter Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError); + if Result=cIncompatible then exit; + end + else if ParamResolved.BaseType=btProc then + begin + // e.g. await(Proc) + if Expr.Parent is TPasExpr then + begin + if RaiseOnError then + RaiseMsg(20200523232827,nXExpectedButYFound,sXExpectedButYFound,['async function',GetResolverResultDescription(ParamResolved)],Expr); + exit; + end; + Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError); end else begin @@ -5284,10 +5398,40 @@ procedure TPas2JSResolver.BI_AWait_OnGetCallResult(Proc: TResElDataBuiltInProc; Params: TParamsExpr; out ResolvedEl: TPasResolverResult); // function await(const Expr: T): T // function await(T; p: TJSPromise): T +// await(Proc()); var - Param: TPasExpr; + Param, PathEnd: TPasExpr; + Ref: TResolvedReference; + Decl: TPasElement; + DeclFunc: TPasFunction; begin Param:=Params.Params[0]; + if length(Params.Params)=1 then + begin + // await(expr) + PathEnd:=GetPathEndIdent(Param,true); + if (PathEnd<>nil) and (PathEnd.CustomData is TResolvedReference) then + begin + Ref:=TResolvedReference(PathEnd.CustomData); + Decl:=Ref.Declaration; + if Decl is TPasFunction then + begin + DeclFunc:=TPasFunction(Decl); + if DeclFunc.IsAsync then + begin + // await(CallAsyncFunction) -> use Pascal result type (not TJSPromise) + // Note the missing rcCall flag + ComputeResultElement(DeclFunc.FuncType.ResultEl,ResolvedEl,[],PathEnd); + exit; + end; + end; + end; + // await(expr:T):T + end + else + begin + // await(T;promise):T + end; ComputeElement(Param,ResolvedEl,[]); Include(ResolvedEl.Flags,rrfReadable); if Proc=nil then ; @@ -5309,6 +5453,42 @@ begin if Proc=nil then ; end; +procedure TPas2JSResolver.BI_AWait_OnFinishParamsExpr( + Proc: TResElDataBuiltInProc; Params: TParamsExpr); +var + P: TPasExprArray; + Param, PathEnd: TPasExpr; + Ref: TResolvedReference; + Decl: TPasElement; +begin + if Proc=nil then ; + P:=Params.Params; + if P=nil then ; + Param:=P[0]; + FinishCallArgAccess(Param,rraRead); + if length(P)=1 then + begin + // await(expr) + PathEnd:=GetPathEndIdent(Param,false); + if (PathEnd<>nil) and (PathEnd.CustomData is TResolvedReference) then + begin + Ref:=TResolvedReference(PathEnd.CustomData); + Decl:=Ref.Declaration; + if Decl is TPasProcedure then + begin + // implicit call + Exclude(Ref.Flags,rrfNoImplicitCallWithoutParams); + Include(Ref.Flags,rrfImplicitCallWithoutParams); + end; + end; + end; + + if length(P)>1 then + FinishCallArgAccess(P[1],rraRead); + if length(P)>2 then + RaiseNotYetImplemented(20200525142451,Params); +end; + constructor TPas2JSResolver.Create; var bt: TPas2jsBaseType; @@ -5407,7 +5587,7 @@ begin // nil,nil,bfCustom,[bipfCanBeStatement]); AddBuiltInProc('AWait','function await(const Expr: T): T', @BI_AWait_OnGetCallCompatibility,@BI_AWait_OnGetCallResult, - @BI_AWait_OnEval,nil,bfCustom,[bipfCanBeStatement]); + @BI_AWait_OnEval,@BI_AWait_OnFinishParamsExpr,bfCustom,[bipfCanBeStatement]); end; function TPas2JSResolver.CheckTypeCastRes(const FromResolved, @@ -6079,6 +6259,33 @@ begin end; end; +procedure TPas2JSResolver.ComputeResultElement(El: TPasResultElement; out + ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags; + StartEl: TPasElement); +var + FuncType: TPasFunctionType; + Proc: TPasProcedure; + JSPromiseClass: TPasClassType; +begin + if (rcCall in Flags) and (El.Parent is TPasFunctionType) then + begin + FuncType:=TPasFunctionType(El.Parent); + if FuncType.Parent is TPasProcedure then + begin + Proc:=TPasProcedure(FuncType.Parent); + if Proc.IsAsync then + begin + // an async function call returns a TJSPromise + JSPromiseClass:=FindTJSPromise(StartEl); + SetResolverIdentifier(ResolvedEl,btContext,El, + JSPromiseClass,JSPromiseClass,[rrfReadable,rrfWritable]); + exit; + end; + end; + end; + inherited ComputeResultElement(El, ResolvedEl, Flags, StartEl); +end; + function TPas2JSResolver.GetElementData(El: TPasElementBase; DataClass: TPas2JsElementDataClass): TPas2JsElementData; begin @@ -12875,10 +13082,12 @@ var Param: TPasExpr; ResultEl: TPasResultElement; TypeEl: TPasType; + aResolver: TPas2JSResolver; begin Result:=nil; Param:=El.Params[0]; - AContext.Resolver.ComputeElement(Param,ParamResolved,[rcNoImplicitProc]); + aResolver:=AContext.Resolver; + aResolver.ComputeElement(Param,ParamResolved,[rcNoImplicitProc]); {$IFDEF VerbosePas2JS} writeln('TPasToJSConverter.ConvertBuiltIn_TypeInfo ',GetResolverResultDbg(ParamResolved)); {$ENDIF} @@ -12886,7 +13095,7 @@ begin begin // typeinfo(function) -> typeinfo(resulttype) ResultEl:=TPasFunction(ParamResolved.IdentEl).FuncType.ResultEl; - AContext.Resolver.ComputeElement(ResultEl.ResultType,ParamResolved,[rcNoImplicitProc]); + aResolver.ComputeResultElement(ResultEl,ParamResolved,[]); {$IFDEF VerbosePas2JS} writeln('TPasToJSConverter.ConvertBuiltIn_TypeInfo FuncResult=',GetResolverResultDbg(ParamResolved)); {$ENDIF} @@ -17393,7 +17602,7 @@ begin RaiseNotSupported(El,AContext,20171225104212); if GetEnumeratorFunc.ClassType<>TPasFunction then RaiseNotSupported(El,AContext,20171225104237); - aResolver.ComputeElement(GetEnumeratorFunc.FuncType.ResultEl,ResolvedEl,[rcType]); + aResolver.ComputeResultElement(GetEnumeratorFunc.FuncType.ResultEl,ResolvedEl,[rcCall]); EnumeratorTypeEl:=ResolvedEl.LoTypeEl; if EnumeratorTypeEl is TPasClassType then diff --git a/packages/pastojs/src/pas2jsfiler.pp b/packages/pastojs/src/pas2jsfiler.pp index 8b3dc0c360..9da79d1d3d 100644 --- a/packages/pastojs/src/pas2jsfiler.pp +++ b/packages/pastojs/src/pas2jsfiler.pp @@ -431,7 +431,8 @@ const 'IsNested', 'Static', 'Varargs', - 'ReferenceTo' + 'ReferenceTo', + 'Async' ); PCUProcedureMessageTypeNames: array[TProcedureMessageType] of string = ( @@ -494,8 +495,7 @@ const 'DispId', 'NoReturn', 'Far', - 'Final', - 'Async' + 'Final' ); PCUProcedureModifiersImplProc = [pmInline,pmAssembler,pmCompilerProc,pmNoReturn]; diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index a70b4c822d..ac52846356 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -340,10 +340,6 @@ type Procedure TestProc_LocalVarInit; Procedure TestProc_ReservedWords; Procedure TestProc_ConstRefWord; - Procedure TestProc_Async; - Procedure TestProc_AWaitOutsideAsyncFail; - Procedure TestProc_AWait; - Procedure TestProc_AWaitExternalClassPromise; // anonymous functions Procedure TestAnonymousProc_Assign_ObjFPC; @@ -356,7 +352,6 @@ type Procedure TestAnonymousProc_NestedAssignResult; Procedure TestAnonymousProc_Class; Procedure TestAnonymousProc_ForLoop; - Procedure TestAnonymousProc_Async; // enums, sets Procedure TestEnum_Name; @@ -865,6 +860,23 @@ type procedure TestRangeChecks_StringIndex; procedure TestRangeChecks_TypecastInt; procedure TestRangeChecks_TypeHelperInt; + + // Async/AWait + Procedure TestAsync_Proc; + Procedure TestAsync_CallResultIsPromise; + Procedure TestAsync_ConstructorFail; + Procedure TestAsync_PropertyGetterFail; + Procedure TestAwait_NonPromiseWithTypeFail; + Procedure TestAWait_OutsideAsyncFail; + Procedure TestAWait_Result; + Procedure TestAWait_ExternalClassPromise; + Procedure TestAsync_AnonymousProc; + // ToDo: proc type, implict call, explicit call, await() + // ToDo: proc type assign async mismatch fail + // ToDo: inherited; + // ToDo: inherited asyncproc; + // ToDo: await(inherited asyncproc); + // ToDo: i:=await(inherited asyncfunc) end; function LinesToStr(Args: array of const): string; @@ -4609,115 +4621,6 @@ 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.TestProc_AWaitOutsideAsyncFail; -begin - StartProgram(false); - Add([ - 'function Crawl(w: double): word; ', - 'begin', - 'end;', - 'function Run(w: double): word;', - 'begin', - ' Result:=await(Crawl(w));', - 'end;', - 'begin', - ' Run(1);']); - SetExpectedPasResolverError(sAWaitOnlyInAsyncProcedure,nAWaitOnlyInAsyncProcedure); - ConvertProgram; -end; - -procedure TTestModule.TestProc_AWait; -begin - StartProgram(false); - Add([ - 'function Crawl(d: double = 1.3): word; ', - 'begin', - 'end;', - 'function Run(d: double): word; async;', - 'begin', - ' Result:=await(1);', - ' Result:=await(Crawl);', - ' Result:=await(Crawl(4.5));', - 'end;', - 'begin', - ' Run(1);']); - ConvertProgram; - CheckSource('TestProc_AWait', - LinesToStr([ // statements - 'this.Crawl = function (d) {', - ' var Result = 0;', - ' return Result;', - '};', - 'this.Run = async function (d) {', - ' var Result = 0;', - ' Result = await 1;', - ' Result = await $mod.Crawl(1.3);', - ' Result = await $mod.Crawl(4.5);', - ' return Result;', - '};', - '']), - LinesToStr([ - '$mod.Run(1);' - ])); -end; - -procedure TTestModule.TestProc_AWaitExternalClassPromise; -begin - StartProgram(false); - Add([ - '{$modeswitch externalclass}', - 'type', - ' TJSPromise = class external name ''Promise''', - ' end;', - 'function Run(d: double): word; async;', - 'var', - ' p: TJSPromise;', - 'begin', - ' Result:=await(word,p);', - 'end;', - 'begin', - ' Run(1);']); - ConvertProgram; - CheckSource('TestProc_AWaitExternalClassPromise', - LinesToStr([ // statements - 'this.Run = async function (d) {', - ' var Result = 0;', - ' var p = null;', - ' Result = await p;', - ' return Result;', - '};', - '']), - LinesToStr([ - '$mod.Run(1);' - ])); -end; - procedure TTestModule.TestAnonymousProc_Assign_ObjFPC; begin StartProgram(false); @@ -5197,44 +5100,6 @@ begin ])); end; -procedure TTestModule.TestAnonymousProc_Async; -begin - StartProgram(false); - Add([ - '{$mode objfpc}', - 'type', - ' TFunc = reference to function(x: double): word;', - 'function Crawl(d: double = 1.3): word; ', - 'begin', - 'end;', - 'var Func: TFunc;', - 'begin', - ' Func:=function(c:double):word async begin', - ' Result:=await(Crawl(c));', - ' end;', - ' Func:=function(c:double):word async assembler asm', - ' end;', - ' ']); - ConvertProgram; - CheckSource('TestAnonymousProc_Async', - LinesToStr([ // statements - 'this.Crawl = function (d) {', - ' var Result = 0;', - ' return Result;', - '};', - 'this.Func = null;', - '']), - LinesToStr([ - '$mod.Func = async function (c) {', - ' var Result = 0;', - ' Result = await $mod.Crawl(c);', - ' return Result;', - '};', - '$mod.Func = async function (c) {', - '};', - ''])); -end; - procedure TTestModule.TestEnum_Name; begin StartProgram(false); @@ -31748,6 +31613,336 @@ begin ''])); end; +procedure TTestModule.TestAsync_Proc; +begin + StartProgram(false); + Add([ + 'procedure Fly(w: word = 1); async; forward;', + 'procedure Run(w: word = 2); async;', + 'begin', + ' Fly(w);', + ' Fly;', + ' await(Fly(w));', + ' await(Fly);', + 'end;', + 'procedure Fly(w: word); ', + 'begin', + 'end;', + 'begin', + ' Run;', + ' Run(3);', + '']); + ConvertProgram; + CheckSource('TestAsync_Proc', + LinesToStr([ // statements + 'this.Run = async function (w) {', + ' $mod.Fly(w);', + ' $mod.Fly(1);', + ' await $mod.Fly(w);', + ' await $mod.Fly(1);', + '};', + 'this.Fly = async function (w) {', + '};', + '']), + LinesToStr([ + '$mod.Run(2);', + '$mod.Run(3);', + ''])); +end; + +procedure TTestModule.TestAsync_CallResultIsPromise; +begin + StartProgram(false); + Add([ + '{$modeswitch externalclass}', + 'type', + ' TObject = class', + ' end;', + ' TJSPromise = class external name ''Promise''', + ' end;', + ' TBird = class', + ' function Fly: word; async; ', + ' end;', + 'function TBird.Fly: word; async; ', + 'begin', + ' Result:=3;', + ' Fly:=4+Result;', + ' if Result=5 then ;', + ' exit(6);', + 'end;', + 'function Run: word; async;', + 'begin', + ' Result:=11+Result;', + ' inc(Result);', + 'end;', + 'var', + ' p: TJSPromise;', + ' o: TBird;', + 'begin', + ' p:=Run;', + ' p:=Run();', + ' if Run=p then ;', + ' if p=Run then ;', + ' if Run()=p then ;', + ' if p=Run() then ;', + ' p:=o.Fly;', + ' p:=o.Fly();', + ' if o.Fly=p then ;', + ' if o.Fly()=p then ;', + ' with o do begin', + ' p:=Fly;', + ' p:=Fly();', + ' if Fly=p then ;', + ' if Fly()=p then ;', + ' end;', + '']); + ConvertProgram; + CheckSource('TestAsync_CallResultIsPromise', + LinesToStr([ // statements + 'rtl.createClass($mod, "TObject", null, function () {', + ' this.$init = function () {', + ' };', + ' this.$final = function () {', + ' };', + '});', + 'rtl.createClass($mod, "TBird", $mod.TObject, function () {', + ' this.Fly = async function () {', + ' var Result = 0;', + ' Result = 3;', + ' Result = 4 + Result;', + ' if (Result === 5) ;', + ' return 6;', + ' return Result;', + ' };', + '});', + 'this.Run = async function () {', + ' var Result = 0;', + ' Result = 11 + Result;', + ' Result += 1;', + ' return Result;', + '};', + 'this.p = null;', + 'this.o = null;', + '']), + LinesToStr([ + '$mod.p = $mod.Run();', + '$mod.p = $mod.Run();', + 'if ($mod.Run() === $mod.p) ;', + 'if ($mod.p === $mod.Run()) ;', + 'if ($mod.Run() === $mod.p) ;', + 'if ($mod.p === $mod.Run()) ;', + '$mod.p = $mod.o.Fly();', + '$mod.p = $mod.o.Fly();', + 'if ($mod.o.Fly() === $mod.p) ;', + 'if ($mod.o.Fly() === $mod.p) ;', + 'var $with1 = $mod.o;', + '$mod.p = $with1.Fly();', + '$mod.p = $with1.Fly();', + 'if ($with1.Fly() === $mod.p) ;', + 'if ($with1.Fly() === $mod.p) ;', + ''])); +end; + +procedure TTestModule.TestAsync_ConstructorFail; +begin + StartProgram(false); + Add([ + 'type', + ' TObject = class', + ' end;', + ' TBird = class', + ' constructor Create; async;', + ' end;', + 'constructor TBird.Create; async;', + 'begin', + 'end;', + 'begin', + '']); + SetExpectedPasResolverError('Invalid constructor modifier async',nInvalidXModifierY); + ConvertProgram; +end; + +procedure TTestModule.TestAsync_PropertyGetterFail; +begin + StartProgram(false); + Add([ + 'type', + ' TObject = class', + ' end;', + ' TBird = class', + ' function GetSize: word; async;', + ' property Size: word read GetSize;', + ' end;', + 'function TBird.GetSize: word; async;', + 'begin', + 'end;', + 'begin', + '']); + SetExpectedPasResolverError('Invalid property getter modifier async',nInvalidXModifierY); + ConvertProgram; +end; + +procedure TTestModule.TestAwait_NonPromiseWithTypeFail; +begin + StartProgram(false); + Add([ + 'procedure Run; async;', + 'begin', + ' await(word,1);', + 'end;', + 'begin', + '']); + SetExpectedPasResolverError('Incompatible type arg no. 2: Got "Longint", expected "TJSPromise"',nIncompatibleTypeArgNo); + ConvertProgram; +end; + +procedure TTestModule.TestAWait_OutsideAsyncFail; +begin + StartProgram(false); + Add([ + 'procedure Crawl(w: double); ', + 'begin', + 'end;', + 'procedure Run(w: double);', + 'begin', + ' await(Crawl(w));', + 'end;', + 'begin', + ' Run(1);']); + SetExpectedPasResolverError(sAWaitOnlyInAsyncProcedure,nAWaitOnlyInAsyncProcedure); + ConvertProgram; +end; + +procedure TTestModule.TestAWait_Result; +begin + StartProgram(false); + Add([ + '{$modeswitch externalclass}', + 'type', + ' TJSPromise = class external name ''Promise''', + ' end;', + 'function Crawl(d: double = 1.3): word; ', + 'begin', + 'end;', + 'function Run(d: double = 1.6): word; async;', + 'begin', + ' Result:=await(1);', + ' Result:=await(Crawl);', + ' Result:=await(Crawl(4.5));', + ' Result:=await(Run);', + ' Result:=await(Run(6.7));', + 'end;', + 'begin', + ' Run(1);']); + ConvertProgram; + CheckSource('TestAWait_Result', + LinesToStr([ // statements + 'this.Crawl = function (d) {', + ' var Result = 0;', + ' return Result;', + '};', + 'this.Run = async function (d) {', + ' var Result = 0;', + ' Result = await 1;', + ' Result = await $mod.Crawl(1.3);', + ' Result = await $mod.Crawl(4.5);', + ' Result = await $mod.Run(1.6);', + ' Result = await $mod.Run(6.7);', + ' return Result;', + '};', + '']), + LinesToStr([ + '$mod.Run(1);' + ])); +end; + +procedure TTestModule.TestAWait_ExternalClassPromise; +begin + StartProgram(false); + Add([ + '{$modeswitch externalclass}', + 'type', + ' TJSPromise = class external name ''Promise''', + ' end;', + 'function Fly(w: word): TJSPromise; async;', + 'begin', + 'end;', + 'function Jump(w: word): word; async;', + 'begin', + 'end;', + 'function Run(d: double): word; async;', + 'var', + ' p: TJSPromise;', + 'begin', + ' Result:=await(word,p);', // promise needs type + ' Result:=await(word,Fly(3));', // promise needs type + ' Result:=await(Jump(4));', // async non promise must omit the type + 'end;', + 'begin', + '']); + ConvertProgram; + CheckSource('TestAWait_ExternalClassPromise', + LinesToStr([ // statements + 'this.Fly = async function (w) {', + ' var Result = null;', + ' return Result;', + '};', + 'this.Jump = async function (w) {', + ' var Result = 0;', + ' return Result;', + '};', + 'this.Run = async function (d) {', + ' var Result = 0;', + ' var p = null;', + ' Result = await p;', + ' Result = await $mod.Fly(3);', + ' Result = await $mod.Jump(4);', + ' return Result;', + '};', + '']), + LinesToStr([ + ])); +end; + +procedure TTestModule.TestAsync_AnonymousProc; +begin + StartProgram(false); + Add([ + '{$mode objfpc}', + 'type', + ' TFunc = reference to function(x: double): word; async;', + 'function Crawl(d: double = 1.3): word; ', + 'begin', + 'end;', + 'var Func: TFunc;', + 'begin', + ' Func:=function(c:double):word async begin', + ' Result:=await(Crawl(c));', + ' end;', + ' Func:=function(c:double):word async assembler asm', + ' end;', + ' ']); + ConvertProgram; + CheckSource('TestAsync_AnonymousProc', + LinesToStr([ // statements + 'this.Crawl = function (d) {', + ' var Result = 0;', + ' return Result;', + '};', + 'this.Func = null;', + '']), + LinesToStr([ + '$mod.Func = async function (c) {', + ' var Result = 0;', + ' Result = await $mod.Crawl(c);', + ' return Result;', + '};', + '$mod.Func = async function (c) {', + '};', + ''])); +end; + + Initialization RegisterTests([TTestModule]); end.