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

fcl-passrc: fixed mem leak on error during parsing function type

Browse Source 
(cherry picked from commit 89abeff99a)
This commit is contained in:
mattias 2022-03-20 17:58:23 +01:00 committed by Mattias Gaertner
parent ee3383d3a8
commit d6cf7f5b5c
3 changed files with 43 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -12082,6 +12082,8 @@ begin
CurName:='';
p:=El.Parent;
repeat
if p=nil then
RaiseNotYetImplemented(20220320165553,El);
if (p is TPasDeclarations) or (p is TPasMembersType) then
begin
if CurName='' then
@ -12563,6 +12565,7 @@ procedure TPasResolver.AddProcedureType(El: TPasProcedureType;
TypeParams: TFPList);
var
Scope: TPasProcTypeScope;
C: TClass;
begin
if El.Name<>'' then
begin
@ -12602,6 +12605,11 @@ begin
else
begin
// anonymous procedure type, e.g. "var p: procedure;"
C:=El.Parent.ClassType;
if C.InheritsFrom(TPasVariable) then
// ok
else
RaiseMsg(20220320165827,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
DeanonymizeType(El);
end;
end;
@ -21244,6 +21252,7 @@ begin
RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
else
RaiseNotYetImplemented(20160922163544,El);
Result:=El;
finally
if Result=nil then

51
packages/fcl-passrc/src/pparser.pp
View File

@ -2330,11 +2330,13 @@ begin
ok:=true;
finally
if not ok then
begin
if Result<>nil then
begin
Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
Result:=nil;
end;
end;
end;
end;
@ -2358,27 +2360,36 @@ end;
function TPasParser.ParseVarType(Parent : TPasElement = Nil): TPasType;
var
NamePos: TPasSourcePos;
ok: Boolean;
begin
NextToken;
case CurToken of
tkProcedure:
begin
Result := TPasProcedureType(CreateElement(TPasProcedureType, '', Parent));
ParseProcedureOrFunction(Result, TPasProcedureType(Result), ptProcedure, True);
if CurToken = tkSemicolon then
UngetToken; // Unget semicolon
end;
tkFunction:
begin
Result := CreateFunctionType('', 'Result', Parent, False, CurSourcePos);
ParseProcedureOrFunction(Result, TPasFunctionType(Result), ptFunction, True);
if CurToken = tkSemicolon then
UngetToken; // Unget semicolon
end;
else
NamePos:=CurSourcePos;
UngetToken;
Result := ParseType(Parent,NamePos);
Result:=nil;
ok:=false;
try
NextToken;
case CurToken of
tkProcedure:
begin
Result := TPasProcedureType(CreateElement(TPasProcedureType, '', Parent));
ParseProcedureOrFunction(Result, TPasProcedureType(Result), ptProcedure, True);
if CurToken = tkSemicolon then
UngetToken; // Unget semicolon
end;
tkFunction:
begin
Result := CreateFunctionType('', 'Result', Parent, False, CurSourcePos);
ParseProcedureOrFunction(Result, TPasFunctionType(Result), ptFunction, True);
if CurToken = tkSemicolon then
UngetToken; // Unget semicolon
end;
else
NamePos:=CurSourcePos;
UngetToken;
Result := ParseType(Parent,NamePos);
end;
ok:=true;
finally
if (not ok) and (Result<>nil) then
Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
end;
end;

8
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -891,7 +891,7 @@ type
Procedure TestProcType_PassProcToUntyped;
// anonymous procedure type
Procedure TestProcTypeAnonymous_FunctionFunctionFail; // ToDo
Procedure TestProcTypeAnonymous_FunctionFunctionFail;
// pointer
Procedure TestPointer;
@ -16526,15 +16526,13 @@ end;
procedure TTestResolver.TestProcTypeAnonymous_FunctionFunctionFail;
begin
exit;
StartProgram(false);
Add([
'var',
' f: function:function:longint;',
'begin']);
CheckParserException('Expected "Identifier or file"',
nParserExpectTokenError);
CheckResolverException('Cannot nest anonymous functional type',
nCannotNestAnonymousX);
end;
procedure TTestResolver.TestPointer;