mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 18:19:16 +02:00
pas2js: async proc type
git-svn-id: trunk@45517 -
This commit is contained in:
parent
d81b21007f
commit
b6e2a228d3
@ -5460,6 +5460,8 @@ var
|
|||||||
Param, PathEnd: TPasExpr;
|
Param, PathEnd: TPasExpr;
|
||||||
Ref: TResolvedReference;
|
Ref: TResolvedReference;
|
||||||
Decl: TPasElement;
|
Decl: TPasElement;
|
||||||
|
ResolvedEl: TPasResolverResult;
|
||||||
|
Implicit: Boolean;
|
||||||
begin
|
begin
|
||||||
if Proc=nil then ;
|
if Proc=nil then ;
|
||||||
P:=Params.Params;
|
P:=Params.Params;
|
||||||
@ -5472,10 +5474,19 @@ begin
|
|||||||
PathEnd:=GetPathEndIdent(Param,false);
|
PathEnd:=GetPathEndIdent(Param,false);
|
||||||
if (PathEnd<>nil) and (PathEnd.CustomData is TResolvedReference) then
|
if (PathEnd<>nil) and (PathEnd.CustomData is TResolvedReference) then
|
||||||
begin
|
begin
|
||||||
|
// await(a.b)
|
||||||
Ref:=TResolvedReference(PathEnd.CustomData);
|
Ref:=TResolvedReference(PathEnd.CustomData);
|
||||||
Decl:=Ref.Declaration;
|
Decl:=Ref.Declaration;
|
||||||
if Decl is TPasProcedure then
|
Implicit:=false;
|
||||||
|
if Decl is TPasVariable then
|
||||||
begin
|
begin
|
||||||
|
ComputeElement(Decl,ResolvedEl,[rcNoImplicitProcType]);
|
||||||
|
if IsProcedureType(ResolvedEl,true) then
|
||||||
|
Implicit:=true;
|
||||||
|
end
|
||||||
|
else if (Decl is TPasProcedure) then
|
||||||
|
Implicit:=true;
|
||||||
|
if Implicit then begin
|
||||||
// implicit call
|
// implicit call
|
||||||
Exclude(Ref.Flags,rrfNoImplicitCallWithoutParams);
|
Exclude(Ref.Flags,rrfNoImplicitCallWithoutParams);
|
||||||
Include(Ref.Flags,rrfImplicitCallWithoutParams);
|
Include(Ref.Flags,rrfImplicitCallWithoutParams);
|
||||||
|
@ -383,7 +383,10 @@ const
|
|||||||
'ClassHelper',
|
'ClassHelper',
|
||||||
'RecordHelper',
|
'RecordHelper',
|
||||||
'TypeHelper',
|
'TypeHelper',
|
||||||
'DispInterface'
|
'DispInterface',
|
||||||
|
'ObjcClass',
|
||||||
|
'ObjcCategory',
|
||||||
|
'ObjcProtocol'
|
||||||
);
|
);
|
||||||
|
|
||||||
PCUClassInterfaceTypeNames: array[TPasClassInterfaceType] of string = (
|
PCUClassInterfaceTypeNames: array[TPasClassInterfaceType] of string = (
|
||||||
|
@ -871,6 +871,7 @@ type
|
|||||||
Procedure TestAWait_Result;
|
Procedure TestAWait_Result;
|
||||||
Procedure TestAWait_ExternalClassPromise;
|
Procedure TestAWait_ExternalClassPromise;
|
||||||
Procedure TestAsync_AnonymousProc;
|
Procedure TestAsync_AnonymousProc;
|
||||||
|
Procedure TestAsync_ProcType;
|
||||||
// ToDo: proc type, implict call, explicit call, await()
|
// ToDo: proc type, implict call, explicit call, await()
|
||||||
// ToDo: proc type assign async mismatch fail
|
// ToDo: proc type assign async mismatch fail
|
||||||
// ToDo: inherited;
|
// ToDo: inherited;
|
||||||
@ -31908,10 +31909,14 @@ procedure TTestModule.TestAsync_AnonymousProc;
|
|||||||
begin
|
begin
|
||||||
StartProgram(false);
|
StartProgram(false);
|
||||||
Add([
|
Add([
|
||||||
|
'{$modeswitch externalclass}',
|
||||||
|
'type',
|
||||||
|
' TJSPromise = class external name ''Promise''',
|
||||||
|
' end;',
|
||||||
'{$mode objfpc}',
|
'{$mode objfpc}',
|
||||||
'type',
|
'type',
|
||||||
' TFunc = reference to function(x: double): word; async;',
|
' TFunc = reference to function(x: double): word; async;',
|
||||||
'function Crawl(d: double = 1.3): word; ',
|
'function Crawl(d: double = 1.3): word; async;',
|
||||||
'begin',
|
'begin',
|
||||||
'end;',
|
'end;',
|
||||||
'var Func: TFunc;',
|
'var Func: TFunc;',
|
||||||
@ -31925,7 +31930,7 @@ begin
|
|||||||
ConvertProgram;
|
ConvertProgram;
|
||||||
CheckSource('TestAsync_AnonymousProc',
|
CheckSource('TestAsync_AnonymousProc',
|
||||||
LinesToStr([ // statements
|
LinesToStr([ // statements
|
||||||
'this.Crawl = function (d) {',
|
'this.Crawl = async function (d) {',
|
||||||
' var Result = 0;',
|
' var Result = 0;',
|
||||||
' return Result;',
|
' return Result;',
|
||||||
'};',
|
'};',
|
||||||
@ -31942,6 +31947,73 @@ begin
|
|||||||
'']));
|
'']));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TTestModule.TestAsync_ProcType;
|
||||||
|
begin
|
||||||
|
StartProgram(false);
|
||||||
|
Add([
|
||||||
|
'{$mode objfpc}',
|
||||||
|
'type',
|
||||||
|
' TRefFunc = reference to function(x: double = 1.3): word; async;',
|
||||||
|
' TFunc = function(x: double = 1.1): word; async;',
|
||||||
|
' TProc = procedure(x: longint = 7); async;',
|
||||||
|
'function Crawl(d: double): word; async;',
|
||||||
|
'begin',
|
||||||
|
'end;',
|
||||||
|
'procedure Run(e:longint); async;',
|
||||||
|
'begin',
|
||||||
|
'end;',
|
||||||
|
'var',
|
||||||
|
' RefFunc: TRefFunc;',
|
||||||
|
' Func: TFunc;',
|
||||||
|
' Proc, ProcB: TProc;',
|
||||||
|
'begin',
|
||||||
|
' Func:=@Crawl;',
|
||||||
|
' RefFunc:=@Crawl;',
|
||||||
|
' RefFunc:=function(c:double):word async begin',
|
||||||
|
' Result:=await(RefFunc);',
|
||||||
|
' Result:=await(RefFunc());',
|
||||||
|
' Result:=await(Func);',
|
||||||
|
' Result:=await(Func());',
|
||||||
|
' await(Proc);',
|
||||||
|
' await(Proc());',
|
||||||
|
' await(Proc(13));',
|
||||||
|
' end;',
|
||||||
|
' Proc:=@Run;',
|
||||||
|
' if Proc=ProcB then ;',
|
||||||
|
' ']);
|
||||||
|
ConvertProgram;
|
||||||
|
CheckSource('TestAsync_ProcType',
|
||||||
|
LinesToStr([ // statements
|
||||||
|
'this.Crawl = async function (d) {',
|
||||||
|
' var Result = 0;',
|
||||||
|
' return Result;',
|
||||||
|
'};',
|
||||||
|
'this.Run = async function (e) {',
|
||||||
|
'};',
|
||||||
|
'this.RefFunc = null;',
|
||||||
|
'this.Func = null;',
|
||||||
|
'this.Proc = null;',
|
||||||
|
'this.ProcB = null;',
|
||||||
|
'']),
|
||||||
|
LinesToStr([
|
||||||
|
'$mod.Func = $mod.Crawl;',
|
||||||
|
'$mod.RefFunc = $mod.Crawl;',
|
||||||
|
'$mod.RefFunc = async function (c) {',
|
||||||
|
' var Result = 0;',
|
||||||
|
' Result = await $mod.RefFunc(1.3);',
|
||||||
|
' Result = await $mod.RefFunc(1.3);',
|
||||||
|
' Result = await $mod.Func(1.1);',
|
||||||
|
' Result = await $mod.Func(1.1);',
|
||||||
|
' await $mod.Proc(7);',
|
||||||
|
' await $mod.Proc(7);',
|
||||||
|
' await $mod.Proc(13);',
|
||||||
|
' return Result;',
|
||||||
|
'};',
|
||||||
|
'$mod.Proc = $mod.Run;',
|
||||||
|
'if (rtl.eqCallback($mod.Proc, $mod.ProcB)) ;',
|
||||||
|
'']));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
Initialization
|
Initialization
|
||||||
RegisterTests([TTestModule]);
|
RegisterTests([TTestModule]);
|
||||||
|
Loading…
Reference in New Issue
Block a user