mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 10:09:20 +02:00
fcl-passrc: fixed checking statement after except-on
git-svn-id: trunk@48211 -
This commit is contained in:
parent
30587299ea
commit
b460f87fd4
@ -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;
|
||||||
|
@ -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
|
||||||
|
@ -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);
|
||||||
|
Loading…
Reference in New Issue
Block a user