View Issue Details

IDProjectCategoryView StatusLast Update
0038962pas2jstranspilerpublic2021-06-04 12:14
Reporterhenrique Assigned To 
PrioritynormalSeverityminorReproducibilityalways
Status newResolutionopen 
PlatformPas2JsOSWindows 
Summary0038962: Procedure returning a promise.
DescriptionThis is the implementation I made for an asynchronous procedure to return a promise.

I know it goes against the concepts of pascal, allowing a procedure to return something, but with this implementation I can use await in a procedure.

Consider whether this is interesting to incorporate into the compiler, in my local repository, everything works as expected.
TagsNo tags attached.
Fixed in Revision
Attached Files

Activities

henrique

2021-06-04 11:43

reporter  

0001-Procedimento-retornando-uma-promessa.patch (5,395 bytes)   
From d2843a719bff0ba77de9dea6429b98d2a331cb3d Mon Sep 17 00:00:00 2001
From: Henrique Gottardi Werlang <henriquewerlang@hotmail.com>
Date: Tue, 1 Jun 2021 14:50:35 -0300
Subject: [PATCH] Procedimento retornando uma promessa.

---
 packages/fcl-passrc/src/pasresolver.pp | 13 +++++++-
 packages/pastojs/src/fppas2js.pp       | 43 ++++++++++++++++++++++----
 2 files changed, 49 insertions(+), 7 deletions(-)

diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp
index 96f2e30fae..98bc8d85ae 100644
--- a/packages/fcl-passrc/src/pasresolver.pp
+++ b/packages/fcl-passrc/src/pasresolver.pp
@@ -2222,7 +2222,7 @@ type
     procedure WriteScopesShort(Title: string);
     // find value and type of an element
     procedure ComputeElement(El: TPasElement; out ResolvedEl: TPasResolverResult;
-      Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil);
+      Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil); virtual;
     procedure ComputeResultElement(El: TPasResultElement; out ResolvedEl: TPasResolverResult;
       Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil); virtual;
     function Eval(Expr: TPasExpr; Flags: TResEvalFlags; Store: boolean = true): TResEvalValue; overload;
@@ -14105,6 +14105,11 @@ begin
         // function call => return result
         ComputeResultElement(TPasFunctionType(Proc.ProcType).ResultEl,ResolvedEl,
           Flags+[rcCall],StartEl)
+      else if Proc.IsAsync then
+        begin
+        // async proc => return promise
+        ComputeElement(Proc,ResolvedEl,Flags+[rcCall],StartEl);
+        end
       else if (Proc.ClassType=TPasConstructor) then
         begin
         // constructor -> return value of type class
@@ -27667,6 +27672,12 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
             ComputeResultElement(TPasFunction(ResolvedEl.IdentEl).FuncType.ResultEl,
               ResolvedEl,Flags+[rcCall],StartEl);
             end
+          else if (ResolvedEl.IdentEl is TPasProcedure)
+              and TPasProcedure(ResolvedEl.IdentEl).IsAsync then
+            begin
+            // async proc => return promise
+            ComputeElement(ResolvedEl.IdentEl,ResolvedEl,Flags+[rcCall],StartEl);
+            end
           else if (ResolvedEl.IdentEl.ClassType=TPasConstructor) then
             begin
             // constructor -> return value of type class
diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp
index 9ebb12f78d..a37b456699 100644
--- a/packages/pastojs/src/fppas2js.pp
+++ b/packages/pastojs/src/fppas2js.pp
@@ -1645,6 +1645,8 @@ 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 ComputeElement(El: TPasElement; out ResolvedEl: TPasResolverResult;
+      Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil); override;
     procedure ComputeResultElement(El: TPasResultElement; out
       ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
       StartEl: TPasElement = nil); override;
@@ -6081,6 +6083,15 @@ begin
           exit(cIncompatible);
         end;
       end
+    else if (ParamResolved.BaseType=btContext)
+        and (ParamResolved.IdentEl is TPasProcedure) then
+      begin
+      if not TPasProcedure(ParamResolved.IdentEl).IsAsync then
+        if RaiseOnError then
+          RaiseMsg(20201229232541,nXExpectedButYFound,sXExpectedButYFound,['async function',GetResolverResultDescription(ParamResolved)],Expr)
+        else
+          exit(cIncompatible)
+      end
     else
       begin
       {$IFDEF VerbosePas2JS}
@@ -7091,13 +7102,36 @@ begin
   end;
 end;
 
+procedure TPas2JSResolver.ComputeElement(El: TPasElement; out
+  ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
+  StartEl: TPasElement);
+var
+  Proc: TPasProcedure;
+  JSPromiseClass: TPasClassType;
+begin
+  if (rcCall in Flags) and (El is TPasProcedure) then
+    begin
+    Proc:=TPasProcedure(El);
+    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;
+  inherited ComputeElement(El,ResolvedEl,Flags,StartEl);
+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
@@ -7107,11 +7141,8 @@ 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;
+        ComputeElement(Proc, ResolvedEl, Flags, StartEl);
+        Exit;
         end;
       end;
     end;
-- 
2.31.1.windows.1

Mattias Gaertner

2021-06-04 12:14

manager   ~0131148

What about tests?
What about procedure types?

Issue History

Date Modified Username Field Change
2021-06-04 11:43 henrique New Issue
2021-06-04 11:43 henrique File Added: 0001-Procedimento-retornando-uma-promessa.patch
2021-06-04 12:14 Mattias Gaertner Note Added: 0131148