paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 17:49:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix bug #36179, allow advanced records in procedures (but not anonymous ones)

Browse Source 
git-svn-id: trunk@43228 -
This commit is contained in:
michael 2019-10-19 13:35:47 +00:00
parent a9340e727f
commit 06f0d7ce87
2 changed files with 57 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -6853,14 +6853,20 @@ function TPasParser.ParseRecordDecl(Parent: TPasElement;
var
ok: Boolean;
allowadvanced : Boolean;
begin
Result := TPasRecordType(CreateElement(TPasRecordType, TypeName, Parent, NamePos));
ok:=false;
try
Result.PackMode:=PackMode;
NextToken;
ParseRecordMembers(Result,tkEnd,
(msAdvancedRecords in Scanner.CurrentModeSwitches) and not (Parent is TProcedureBody));
allowAdvanced:=(msAdvancedRecords in Scanner.CurrentModeSwitches);
// not allowed in anonymous procedures
if (Parent is TProcedureBody) then
if TProcedureBody(Parent).Parent is TPasAnonymousProcedure then
allowAdvanced:=False;
ParseRecordMembers(Result,tkEnd,allowAdvanced);
Engine.FinishScope(stTypeDef,Result);
ok:=true;
finally

49
packages/fcl-passrc/tests/tctypeparser.pas
View File

@ -361,6 +361,8 @@ type
Procedure TestAdvRec_ProcOverrideFail;
Procedure TestAdvRec_ProcMessageFail;
Procedure TestAdvRec_DestructorFail;
Procedure TestAdvRecordInFunction;
Procedure TestAdvRecordInAnonFunction;
end;
{ TTestProcedureTypeParser }
@ -2607,6 +2609,53 @@ begin
ParseRecordFail(SParserNoConstructorAllowed,nParserNoConstructorAllowed);
end;
procedure TTestRecordTypeParser.TestAdvRecordInFunction;
// Src from bug report 36179
Const
Src =
'{$mode objfpc}'+sLineBreak+
'{$modeswitch advancedrecords}'+sLineBreak+
'program afile;'+sLineBreak+
' procedure DoThis;'+sLineBreak+
' type'+sLineBreak+
' TMyRecord = record'+sLineBreak+
' private'+sLineBreak+
' x, y, z: integer;'+sLineBreak+
' end;'+sLineBreak+
' begin'+sLineBreak+
' end;'+sLineBreak+
'begin'+sLineBreak+
'end.';
begin
Source.Text:=Src;
ParseModule;
end;
procedure TTestRecordTypeParser.TestAdvRecordInAnonFunction;
Const
Src =
'{$mode objfpc}'+sLineBreak+
'{$modeswitch advancedrecords}'+sLineBreak+
'program afile;'+sLineBreak+
'var a : Procedure;'+sLineBreak+
'begin'+sLineBreak+
' a := '+sLineBreak+
' procedure '+sLineBreak+
' type'+sLineBreak+
' TMyRecord = record'+sLineBreak+
' private'+sLineBreak+
' x, y, z: integer;'+sLineBreak+
' end;'+sLineBreak+
' begin'+sLineBreak+
' end;'+sLineBreak+
'end.';
begin
Source.Text:=Src;
AssertException('Advanced records not allowed in anonymous function',EParserError,@ParseModule);
end;
{ TBaseTestTypeParser }
Function TBaseTestTypeParser.ParseType(ASource: String; ATypeClass: TClass;