paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 04:39:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: fixed absolute result

Browse Source
This commit is contained in:
mattias 2022-05-22 23:46:29 +02:00
parent 4c8e802dd3
commit 20e3a7311c
3 changed files with 58 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
packages/fcl-passrc/src/pasresolver.pp
View File

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

3
packages/pastojs/src/fppas2js.pp
View File

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

54
packages/pastojs/tests/tcmodules.pas
View File

@ -387,6 +387,7 @@ type
Procedure TestProc_ConstOrder; Procedure TestProc_ConstOrder;
Procedure TestProc_DuplicateConst; Procedure TestProc_DuplicateConst;
Procedure TestProc_LocalVarAbsolute; Procedure TestProc_LocalVarAbsolute;
Procedure TestProc_ResultAbsolute;
Procedure TestProc_LocalVarInit; Procedure TestProc_LocalVarInit;
Procedure TestProc_ReservedWords; Procedure TestProc_ReservedWords;
Procedure TestProc_ConstRefWord; Procedure TestProc_ConstRefWord;
@ -5526,6 +5527,59 @@ begin
])); ]));
end; 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; procedure TTestModule.TestProc_LocalVarInit;
begin begin
StartProgram(false); StartProgram(false);