Codetools: Fix parsing variant records with pointers to procedure. Issue #40145, patch by Domingo Galmés.

This commit is contained in:
Juha 2023-03-04 14:16:04 +02:00
parent 57c8af94ae
commit a9752b1326

View File

@ -5192,6 +5192,8 @@ begin
end;
function TPascalParserTool.KeyWordFuncTypeRecordCase: boolean;
var
IsProcedure:boolean;
{ after parsing CurPos is on the 'end' or the ')'
record
@ -5214,6 +5216,19 @@ function TPascalParserTool.KeyWordFuncTypeRecordCase: boolean;
);
end;
end;
record
field1:string;
field2:integer;
case integer of
1:(pp1:procedure());
2:(fp1:function(a:integer;b:boolean):boolean);
3:(pp2:procedure(aa:integer;bb:boolean);cdecl;deprecated;);
4:(pp3:procedure deprecated; bb1:boolean);
5:(fp2:function(a:integer;b:boolean):boolean; bbb:integer);
6:(fp3:function(a:integer;b:boolean):boolean of object);
7:(pp4:procedure (a:integer);cdecl deprecated;);
8:(pp5:procedure;cdecl;);
end;
}
{off $DEFINE VerboseRecordCase}
procedure RaiseCaseOnlyAllowedInRecords;
@ -5353,6 +5368,7 @@ begin
ReadNextAtom; // read next variable name
until false;
ReadNextAtom; // read type
IsProcedure:=(CurPos.Flag=cafWord) and UpAtomIs('PROCEDURE');
Result:=ParseType(CurPos.StartPos);
if not Result then begin
{$IFDEF VerboseRecordCase}
@ -5363,10 +5379,14 @@ begin
{$IFDEF VerboseRecordCase}
debugln(['TPascalParserTool.KeyWordFuncTypeRecordCase Hint modifier: "',GetAtom,'"']);
{$ENDIF}
if (CurPos.Flag=cafRoundBracketClose) and IsProcedure then //skip ')' closing parameters list in procedures.
ReadNextAtom;
if CurPos.Flag=cafWord then
ReadHintModifiers(false);
CurNode.EndPos:=CurPos.EndPos;
EndChildNode; // close variable definition
if CurPos.Flag=cafWord then //skip return type of function or last modifier.
ReadNextAtom;
end;
{$IFDEF VerboseRecordCase}
debugln(['TPascalParserTool.KeyWordFuncTypeRecordCase variable end="',GetAtom,'"']);