fcl-passrc: fixed checking statement after except-on

git-svn-id: trunk@48211 -
This commit is contained in:
Mattias Gaertner 2021-01-19 19:08:26 +00:00
parent 30587299ea
commit b460f87fd4
3 changed files with 61 additions and 13 deletions

View File

@ -3937,10 +3937,16 @@ end;
{ EPasResolve } { EPasResolve }
procedure EPasResolve.SetPasElement(AValue: TPasElement); procedure EPasResolve.SetPasElement(AValue: TPasElement);
var
Old: TPasElement;
begin begin
if FPasElement=AValue then Exit; if FPasElement=AValue then Exit;
if PasElement<>nil then Old:=FPasElement;
if Old<>nil then
begin
Old:=nil;
PasElement.Release{$IFDEF CheckPasTreeRefCount}('EPasResolve.SetPasElement'){$ENDIF}; PasElement.Release{$IFDEF CheckPasTreeRefCount}('EPasResolve.SetPasElement'){$ENDIF};
end;
FPasElement:=AValue; FPasElement:=AValue;
if PasElement<>nil then if PasElement<>nil then
PasElement.AddRef{$IFDEF CheckPasTreeRefCount}('EPasResolve.SetPasElement'){$ENDIF}; PasElement.AddRef{$IFDEF CheckPasTreeRefCount}('EPasResolve.SetPasElement'){$ENDIF};
@ -7526,11 +7532,13 @@ procedure TPasResolver.FinishExceptOnExpr;
var var
El: TPasImplExceptOn; El: TPasImplExceptOn;
ResolvedType: TPasResolverResult; ResolvedType: TPasResolverResult;
TypeEl: TPasType;
begin begin
CheckTopScope(TPasExceptOnScope); CheckTopScope(TPasExceptOnScope);
El:=TPasImplExceptOn(FTopScope.Element); El:=TPasImplExceptOn(FTopScope.Element);
ComputeElement(El.TypeEl,ResolvedType,[rcType]); TypeEl:=El.TypeEl;
CheckIsClass(El.TypeEl,ResolvedType); ComputeElement(TypeEl,ResolvedType,[rcType]);
CheckIsClass(TypeEl,ResolvedType);
end; end;
procedure TPasResolver.FinishExceptOnStatement; procedure TPasResolver.FinishExceptOnStatement;

View File

@ -6001,10 +6001,23 @@ var
function CloseBlock: boolean; // true if parent reached function CloseBlock: boolean; // true if parent reached
var C: TPasImplBlockClass; var C: TPasImplBlockClass;
NeedUnget: Boolean;
begin begin
C:=TPasImplBlockClass(CurBlock.ClassType); C:=TPasImplBlockClass(CurBlock.ClassType);
if C=TPasImplExceptOn then if C=TPasImplExceptOn then
Engine.FinishScope(stExceptOnStatement,CurBlock) begin
Engine.FinishScope(stExceptOnStatement,CurBlock);
NeedUnget:=CurToken=tkSemicolon;
if NeedUnget then
NextToken;
if (CurToken in [tkend,tkelse])
or ((CurToken=tkIdentifier) and (lowercase(CurTokenString)='on')) then
// ok
else
ParseExcExpectedAorB('end','on');
if NeedUnget then
UngetToken;
end
else if C=TPasImplWithDo then else if C=TPasImplWithDo then
Engine.FinishScope(stWithExpr,CurBlock); Engine.FinishScope(stWithExpr,CurBlock);
CurBlock:=CurBlock.Parent as TPasImplBlock; CurBlock:=CurBlock.Parent as TPasImplBlock;
@ -6063,6 +6076,7 @@ var
TypeEl: TPasType; TypeEl: TPasType;
ImplRaise: TPasImplRaise; ImplRaise: TPasImplRaise;
VarEl: TPasVariable; VarEl: TPasVariable;
ImplExceptOn: TPasImplExceptOn;
begin begin
NewImplElement:=nil; NewImplElement:=nil;
@ -6486,6 +6500,8 @@ begin
// ParseExc; // ParseExc;
CheckStatementCanStart; CheckStatementCanStart;
//writeln('TPasParser.ParseStatement ',CurToken,' ',CurTokenString);
// On is usable as an identifier // On is usable as an identifier
if lowerCase(CurTokenText)='on' then if lowerCase(CurTokenText)='on' then
begin begin
@ -6496,31 +6512,33 @@ begin
begin begin
SrcPos:=CurTokenPos; SrcPos:=CurTokenPos;
ExpectIdentifier; ExpectIdentifier;
El:=TPasImplExceptOn(CreateElement(TPasImplExceptOn,'',CurBlock,SrcPos)); ImplExceptOn:=TPasImplExceptOn(CreateElement(TPasImplExceptOn,'',CurBlock,SrcPos));
El:=ImplExceptOn;
SrcPos:=CurSourcePos; SrcPos:=CurSourcePos;
Name:=CurTokenString; Name:=CurTokenString;
NextToken; NextToken;
//writeln('TPasParser.ParseStatement ',CurToken,' ',CurTokenString);
//writeln('ON t=',Name,' Token=',CurTokenText); //writeln('ON t=',Name,' Token=',CurTokenText);
if CurToken=tkColon then if CurToken=tkColon then
begin begin
// the first expression was the variable name // the first expression was the variable name
NextToken; NextToken;
TypeEl:=ParseSimpleType(El,SrcPos,''); TypeEl:=ParseSimpleType(ImplExceptOn,SrcPos,'');
TPasImplExceptOn(El).TypeEl:=TypeEl; ImplExceptOn.TypeEl:=TypeEl;
VarEl:=TPasVariable(CreateElement(TPasVariable,Name,El,SrcPos)); VarEl:=TPasVariable(CreateElement(TPasVariable,Name,ImplExceptOn,SrcPos));
TPasImplExceptOn(El).VarEl:=VarEl; ImplExceptOn.VarEl:=VarEl;
VarEl.VarType:=TypeEl; VarEl.VarType:=TypeEl;
TypeEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasVariable.VarType'){$ENDIF}; TypeEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasVariable.VarType'){$ENDIF};
if TypeEl.Parent=El then if TypeEl.Parent=ImplExceptOn then
TypeEl.Parent:=VarEl; TypeEl.Parent:=VarEl;
end end
else else
begin begin
UngetToken; UngetToken;
TPasImplExceptOn(El).TypeEl:=ParseSimpleType(El,SrcPos,''); ImplExceptOn.TypeEl:=ParseSimpleType(ImplExceptOn,SrcPos,'');
end; end;
Engine.FinishScope(stExceptOnExpr,El); Engine.FinishScope(stExceptOnExpr,ImplExceptOn);
CreateBlock(TPasImplExceptOn(El)); CreateBlock(ImplExceptOn);
El:=nil; El:=nil;
ExpectToken(tkDo); ExpectToken(tkDo);
end else end else

View File

@ -345,6 +345,7 @@ type
Procedure TestTryStatement; Procedure TestTryStatement;
Procedure TestTryExceptOnNonTypeFail; Procedure TestTryExceptOnNonTypeFail;
Procedure TestTryExceptOnNonClassFail; Procedure TestTryExceptOnNonClassFail;
Procedure TestTryStatementMissingOnFail;
Procedure TestRaiseNonVarFail; Procedure TestRaiseNonVarFail;
Procedure TestRaiseNonClassFail; Procedure TestRaiseNonClassFail;
Procedure TestRaiseDescendant; Procedure TestRaiseDescendant;
@ -1736,6 +1737,8 @@ begin
end; end;
ok:=true; ok:=true;
end; end;
on E: Exception do
Fail('Expected EPasResolve but got '+E.ClassName);
end; end;
AssertEquals('Missing resolver error {'+Msg+'} ('+IntToStr(MsgNumber)+')',true,ok); AssertEquals('Missing resolver error {'+Msg+'} ('+IntToStr(MsgNumber)+')',true,ok);
end; end;
@ -1756,6 +1759,8 @@ begin
MsgNumber,Parser.LastMsgNumber); MsgNumber,Parser.LastMsgNumber);
ok:=true; ok:=true;
end; end;
on E: Exception do
Fail('Expected EParserError but got '+E.ClassName);
end; end;
AssertEquals('Missing parser error '+Msg+' ('+IntToStr(MsgNumber)+')',true,ok); AssertEquals('Missing parser error '+Msg+' ('+IntToStr(MsgNumber)+')',true,ok);
end; end;
@ -5414,6 +5419,23 @@ begin
CheckResolverException('class expected, but Longint found',nXExpectedButYFound); CheckResolverException('class expected, but Longint found',nXExpectedButYFound);
end; end;
procedure TTestResolver.TestTryStatementMissingOnFail;
begin
StartProgram(true,[supTObject]);
Add([
'procedure Run;',
'begin',
' try',
' except',
' on TObject do ;',
' Run;',
' end;',
'end;',
'begin',
'']);
CheckParserException('Expected "end" or "on"',nParserExpectToken2Error);
end;
procedure TTestResolver.TestRaiseNonVarFail; procedure TTestResolver.TestRaiseNonVarFail;
begin begin
StartProgram(false); StartProgram(false);