pastojs: fixed parsing if-then-raise-else

git-svn-id: trunk@40129 -
This commit is contained in:
Mattias Gaertner 2018-11-01 00:19:39 +00:00
parent 057534ef47
commit a34b1f36e0
3 changed files with 47 additions and 9 deletions

View File

@ -5772,7 +5772,7 @@ begin
NextToken;
ImplRaise.ExceptAddr:=DoParseExpression(ImplRaise);
end;
if Curtoken in [tkSemicolon,tkEnd] then
if Curtoken in [tkElse,tkEnd,tkSemicolon] then
UngetToken
end;
end;

View File

@ -15628,31 +15628,30 @@ Var
ok: Boolean;
begin
Result:=nil;
if AContext=nil then ;
C:=Nil;
BThen:=Nil;
BElse:=Nil;
ok:=false;
try
C:=ConvertElement(El.ConditionExpr,AContext);
if Assigned(El.IfBranch) then
BThen:=ConvertElement(El.IfBranch,AContext);
if Assigned(El.ElseBranch) then
BElse:=ConvertElement(El.ElseBranch,AContext);
ok:=true;
T:=TJSIfStatement(CreateElement(TJSIfStatement,El));
T.Cond:=C;
T.BTrue:=BThen;
T.BFalse:=BElse;
Result:=T;
finally
if not ok then
if Result=nil then
begin
FreeAndNil(C);
FreeAndNil(BThen);
FreeAndNil(BElse);
end;
end;
T:=TJSIfStatement(CreateElement(TJSIfStatement,El));
T.Cond:=C;
T.BTrue:=BThen;
T.BFalse:=BElse;
Result:=T;
end;
function TPasToJSConverter.ConvertWhileStatement(El: TPasImplWhileDo;

View File

@ -372,6 +372,7 @@ type
Procedure TestTryFinally;
Procedure TestTryExcept;
Procedure TestTryExcept_ReservedWords;
Procedure TestIfThenRaiseElse;
Procedure TestCaseOf;
Procedure TestCaseOf_UseSwitch;
Procedure TestCaseOfNoElse;
@ -6765,6 +6766,44 @@ begin
'']));
end;
procedure TTestModule.TestIfThenRaiseElse;
begin
StartProgram(false);
Add([
'type',
' TObject = class',
' constructor Create;',
' end;',
'constructor TObject.Create;',
'begin',
'end;',
'var b: boolean;',
'begin',
' if b then',
' raise TObject.Create',
' else',
' b:=false;',
'']);
ConvertProgram;
CheckSource('TestIfThenRaiseElse',
LinesToStr([ // statements
'rtl.createClass($mod, "TObject", null, function () {',
' this.$init = function () {',
' };',
' this.$final = function () {',
' };',
' this.Create = function () {',
' };',
'});',
'this.b = false;',
'']),
LinesToStr([ // $mod.$main
'if ($mod.b) {',
' throw $mod.TObject.$create("Create")}',
' else $mod.b = false;',
'']));
end;
procedure TTestModule.TestCaseOf;
begin
StartProgram(false);