Browse Source

pastojs: fixed absolute result

mattias 3 years ago
parent
commit
20e3a7311c

+ 2 - 1
packages/fcl-passrc/src/pasresolver.pp

@@ -7919,7 +7919,8 @@ begin
     C:=ResolvedAbs.IdentEl.ClassType;
     if (C=TPasVariable)
         or (C=TPasArgument)
-        or ((C=TPasConst) and (TPasConst(ResolvedAbs.IdentEl).VarType<>nil)) then
+        or ((C=TPasConst) and (TPasConst(ResolvedAbs.IdentEl).VarType<>nil))
+        or (C=TPasResultElement) then
     else
       RaiseMsg(20171225235203,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
     if not (rrfReadable in ResolvedAbs.Flags) then

+ 2 - 1
packages/pastojs/src/fppas2js.pp

@@ -4449,7 +4449,8 @@ begin
       begin
       // local var
       if (AbsIdent.Parent is TProcedureBody)
-          or (AbsIdent is TPasArgument) then
+          or (AbsIdent is TPasArgument)
+          or (AbsIdent is TPasResultElement) then
         // ok
       else
         begin

+ 54 - 0
packages/pastojs/tests/tcmodules.pas

@@ -387,6 +387,7 @@ type
     Procedure TestProc_ConstOrder;
     Procedure TestProc_DuplicateConst;
     Procedure TestProc_LocalVarAbsolute;
+    Procedure TestProc_ResultAbsolute;
     Procedure TestProc_LocalVarInit;
     Procedure TestProc_ReservedWords;
     Procedure TestProc_ConstRefWord;
@@ -5526,6 +5527,59 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestProc_ResultAbsolute;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    Index: longint;',
+  '    function DoAbs: pointer;',
+  '  end;',
+  'function TObject.DoAbs: pointer;',
+  'var',
+  '  o: TObject absolute Result;',
+  'begin',
+  '  if o.Index<o.Index then o.Index:=o.Index;',
+  'end;',
+  'function DoIt: jsvalue;',
+  'var',
+  '  d: double absolute Result;',
+  '  s: string absolute Result;',
+  '  o: TObject absolute Result;',
+  'begin',
+  '  if d=d then d:=d;',
+  '  if s=s then s:=s;',
+  '  if o.Index<o.Index then o.Index:=o.Index;',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestProc_ResultAbsolute',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.Index = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoAbs = function () {',
+    '    var Result = null;',
+    '    if (Result.Index < Result.Index) Result.Index = Result.Index;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.DoIt = function () {',
+    '  var Result = undefined;',
+    '  if (Result === Result) Result = Result;',
+    '  if (Result === Result) Result = Result;',
+    '  if (Result.Index < Result.Index) Result.Index = Result.Index;',
+    '  return Result;',
+    '};',
+    '']),
+    LinesToStr([
+    ]));
+end;
+
 procedure TTestModule.TestProc_LocalVarInit;
 begin
   StartProgram(false);