pas2js: fixed try exit(value) finally read Result end

git-svn-id: trunk@45714 -

packages/fcl-passrc/src/pasresolver.pp

@@ -1280,6 +1280,7 @@ type
   TPRResolveVarAccesses = set of TResolvedRefAccess;
 
 const
+  rraAllRead = [rraRead,rraReadAndAssign,rraVarParam];
   rraAllWrite = [rraAssign,rraReadAndAssign,rraVarParam,rraOutParam];
 
   ResolvedToPSRefAccess: array[TResolvedRefAccess] of TPSRefAccess = (

packages/fcl-passrc/src/pastree.pp

@@ -1183,6 +1183,7 @@ type
   { TPasClassOperator }
 
   TPasClassOperator = class(TPasOperator)
+  public
     function TypeName: string; override;
     function GetProcTypeEnum: TProcType; override;
   end;
@@ -1633,7 +1634,7 @@ type
   TPasImplTryExceptElse = class(TPasImplTryHandler)
   end;
 
-  { TPasImplExceptOn }
+  { TPasImplExceptOn - Parent is TPasImplTryExcept }
 
   TPasImplExceptOn = class(TPasImplStatement)
   public

packages/pastojs/src/fppas2js.pp

@@ -1384,6 +1384,14 @@ type
       end;
       PHasAnoFuncData = ^THasAnoFuncData;
     procedure OnHasAnonymousEl(El: TPasElement; arg: pointer);
+  protected
+    type
+      THasElReadingDeclData = record
+        Decl: TPasElement;
+        El: TPasElement;
+      end;
+      PHasElReadingDeclData = ^THasElReadingDeclData;
+    procedure OnHasElReadingDecl(El: TPasElement; arg: pointer);
   protected
     type
       TPRFindExtSystemClass = record
@@ -1563,7 +1571,8 @@ type
       InResolved: TPasResolverResult; out ArgResolved, LengthResolved,
       PropResultResolved: TPasResolverResult): boolean;
     function IsHelperMethod(El: TPasElement): boolean; override;
-    function IsHelperForMember(El: TPasElement): boolean;
+    function IsHelperForMember(El: TPasElement): boolean; virtual;
+    function ImplBlockReadsDecl(Block: TPasImplBlock; Decl: TPasElement): boolean; virtual;
   end;
 
 //------------------------------------------------------------------------------
@@ -2980,6 +2989,22 @@ begin
   Data^.Expr:=TProcedureExpr(El);
 end;
 
+procedure TPas2JSResolver.OnHasElReadingDecl(El: TPasElement; arg: pointer);
+var
+  Data: PHasElReadingDeclData absolute arg;
+  Ref: TResolvedReference;
+begin
+  if Data^.El<>nil then exit;
+  if El.CustomData is TResolvedReference then
+    begin
+    Ref:=TResolvedReference(El.CustomData);
+    if (Ref.Declaration=Data^.Decl) and (Ref.Access in rraAllRead) then
+      begin
+      Data^.El:=El;
+      end;
+    end;
+end;
+
 procedure TPas2JSResolver.OnFindExtSystemClass(El: TPasElement; ElScope,
   StartScope: TPasScope; FindExtSystemClassData: Pointer; var Abort: boolean);
 var
@@ -6789,6 +6814,17 @@ begin
     Result:=true;
 end;
 
+function TPas2JSResolver.ImplBlockReadsDecl(Block: TPasImplBlock;
+  Decl: TPasElement): boolean;
+var
+  Data: THasElReadingDeclData;
+begin
+  Data.Decl:=Decl;
+  Data.El:=nil;
+  Block.ForEachCall(@OnHasElReadingDecl,@Data);
+  Result:=Data.El<>nil;
+end;
+
 { TParamContext }
 
 constructor TParamContext.Create(PasEl: TPasElement; JSEl: TJSElement;
@@ -11988,39 +12024,91 @@ function TPasToJSConverter.ConvertBuiltIn_Exit(El: TPasExpr;
 // convert "exit;" -> in a function: "return result;"  in a procedure: "return;"
 // convert "exit(param);" -> "return param;"
 var
-  ProcEl: TPasElement;
-  Scope: TPas2JSProcedureScope;
-  VarName: String;
+  ParentEl: TPasElement;
+  ImplProcScope: TPas2JSProcedureScope;
+  ResultVarName: String;
   FuncContext: TFunctionContext;
   AssignSt: TJSSimpleAssignStatement;
   St: TJSStatementList;
-  Proc: TPasProcedure;
+  ImplProc, DeclProc: TPasProcedure;
+  ImplTry: TPasImplTry;
+  ResultIsRead: Boolean;
+  ResultEl: TPasResultElement;
 begin
   {$IFDEF VerbosePas2JS}
   writeln('TPasToJSConverter.ConvertBuiltIn_Exit ',GetObjName(El));
   {$ENDIF}
-  ProcEl:=El.Parent;
-  while (ProcEl<>nil) and not (ProcEl is TPasProcedure) do
-    ProcEl:=ProcEl.Parent;
-  // ProcEl can be nil, when exit is in program begin block
-  Proc:=TPasProcedure(ProcEl);
+  ParentEl:=El.Parent;
+  while (ParentEl<>nil) and not (ParentEl is TPasProcedure) do
+    ParentEl:=ParentEl.Parent;
+  // ParentEl can be nil, when exit is in program begin block
+  ImplProc:=TPasProcedure(ParentEl);
+  ResultVarName:='';
+  if ImplProc<>nil then
+    begin
+    ImplProcScope:=ImplProc.CustomData as TPas2JSProcedureScope;
+    if ImplProc.ProcType is TPasFunctionType then
+      begin
+      ResultVarName:=ImplProcScope.ResultVarName; // ResultVarName needs ImplProc
+      if ResultVarName='' then
+        ResultVarName:=ResolverResultVar;
+      end;
+    end;
   Result:=TJSReturnStatement(CreateElement(TJSReturnStatement,El));
   if (El is TParamsExpr) and (length(TParamsExpr(El).Params)>0) then
     begin
-    // with parameter. convert "exit(param);" -> "return param;"
-    TJSReturnStatement(Result).Expr:=ConvertExpression(TParamsExpr(El).Params[0],AContext);
+    // with parameter, e.g. "exit(param);"
+    ResultIsRead:=false;
+    if (ResultVarName<>'') then
+      begin
+      DeclProc:=ImplProcScope.DeclarationProc;
+      if DeclProc=nil then
+        DeclProc:=ImplProc; // Note: references refer to ResultEl of DeclProc
+      ResultEl:=TPasFunctionType(DeclProc.ProcType).ResultEl;
+      ParentEl:=El.Parent;
+      while (ParentEl<>ImplProc) do
+        begin
+        if ParentEl is TPasImplTry then
+          begin
+          ImplTry:=TPasImplTry(ParentEl);
+          if ImplTry.FinallyExcept is TPasImplTryFinally then
+            begin
+            if AContext.Resolver.ImplBlockReadsDecl(ImplTry.FinallyExcept,ResultEl) then
+              begin
+              ResultIsRead:=true;
+              break;
+              end;
+            end;
+          end;
+        ParentEl:=ParentEl.Parent;
+        end;
+      end;
+
+    if ResultIsRead then
+      begin
+      // create "Result = param; return Result;"
+      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+      AssignSt.LHS:=CreatePrimitiveDotExpr(ResultVarName,El);
+      AssignSt.Expr:=ConvertExpression(TParamsExpr(El).Params[0],AContext);
+      TJSReturnStatement(Result).Expr:=CreatePrimitiveDotExpr(ResultVarName,El);
+      St:=TJSStatementList(CreateElement(TJSStatementList,El));
+      St.A:=AssignSt;
+      St.B:=Result;
+      Result:=St;
+      end
+    else
+      begin
+      // create "return param;"
+      TJSReturnStatement(Result).Expr:=ConvertExpression(TParamsExpr(El).Params[0],AContext);
+      end;
     end
   else
     begin
     // without parameter
-    if (Proc<>nil) and (Proc.ProcType is TPasFunctionType) then
-      begin
-      // in a function, "return result;"
-      Scope:=Proc.CustomData as TPas2JSProcedureScope;
-      VarName:=Scope.ResultVarName;
-      if VarName='' then
-        VarName:=ResolverResultVar;
-      TJSReturnStatement(Result).Expr:=CreatePrimitiveDotExpr(VarName,El);
+    if (ResultVarName<>'') then
+      begin
+      // in a function, "return Result;"
+      TJSReturnStatement(Result).Expr:=CreatePrimitiveDotExpr(ResultVarName,El);
       end
     else
       ; // in a procedure, "return;" which means "return undefined;"

packages/pastojs/tests/tcmodules.pas

@@ -319,6 +319,7 @@ type
     Procedure TestFunctionResultInForLoop;
     Procedure TestFunctionResultInTypeCast;
     Procedure TestExit;
+    Procedure TestExit_ResultInFinally;
     Procedure TestBreak;
     Procedure TestBreakAsVar;
     Procedure TestContinue;
@@ -3731,6 +3732,77 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestExit_ResultInFinally;
+begin
+  StartProgram(false);
+  Add([
+  'function Run: word;',
+  'begin',
+  '  try',
+  '    exit(3);', // no Result in finally -> use return 3
+  '  finally',
+  '  end;',
+  'end;',
+  'function Fly: word;',
+  'begin',
+  '  try',
+  '    exit(3);',
+  '  finally',
+  '    if Result>0 then ;',
+  '  end;',
+  'end;',
+  'function Jump: word;',
+  'begin',
+  '  try',
+  '    try',
+  '      exit(4);',
+  '    finally',
+  '    end;',
+  '  finally',
+  '    if Result>0 then ;',
+  '  end;',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestExit_ResultInFinally',
+    LinesToStr([ // statements
+    'this.Run = function () {',
+    '  var Result = 0;',
+    '  try {',
+    '    return 3;',
+    '  } finally {',
+    '  };',
+    '  return Result;',
+    '};',
+    'this.Fly = function () {',
+    '  var Result = 0;',
+    '  try {',
+    '    Result = 3;',
+    '    return Result;',
+    '  } finally {',
+    '    if (Result > 0) ;',
+    '  };',
+    '  return Result;',
+    '};',
+    'this.Jump = function () {',
+    '  var Result = 0;',
+    '  try {',
+    '    try {',
+    '      Result = 4;',
+    '      return Result;',
+    '    } finally {',
+    '    };',
+    '  } finally {',
+    '    if (Result > 0) ;',
+    '  };',
+    '  return Result;',
+    '};',
+    '']),
+    LinesToStr([
+    '']));
+end;
+
 procedure TTestModule.TestBreak;
 begin
   StartProgram(false);