mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-20 11:29:22 +02:00
* Fix bug #36179, allow advanced records in procedures (but not anonymous ones)
git-svn-id: trunk@43228 -
This commit is contained in:
parent
a9340e727f
commit
06f0d7ce87
@ -6853,14 +6853,20 @@ function TPasParser.ParseRecordDecl(Parent: TPasElement;
|
|||||||
|
|
||||||
var
|
var
|
||||||
ok: Boolean;
|
ok: Boolean;
|
||||||
|
allowadvanced : Boolean;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result := TPasRecordType(CreateElement(TPasRecordType, TypeName, Parent, NamePos));
|
Result := TPasRecordType(CreateElement(TPasRecordType, TypeName, Parent, NamePos));
|
||||||
ok:=false;
|
ok:=false;
|
||||||
try
|
try
|
||||||
Result.PackMode:=PackMode;
|
Result.PackMode:=PackMode;
|
||||||
NextToken;
|
NextToken;
|
||||||
ParseRecordMembers(Result,tkEnd,
|
allowAdvanced:=(msAdvancedRecords in Scanner.CurrentModeSwitches);
|
||||||
(msAdvancedRecords in Scanner.CurrentModeSwitches) and not (Parent is TProcedureBody));
|
// 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);
|
Engine.FinishScope(stTypeDef,Result);
|
||||||
ok:=true;
|
ok:=true;
|
||||||
finally
|
finally
|
||||||
|
@ -361,6 +361,8 @@ type
|
|||||||
Procedure TestAdvRec_ProcOverrideFail;
|
Procedure TestAdvRec_ProcOverrideFail;
|
||||||
Procedure TestAdvRec_ProcMessageFail;
|
Procedure TestAdvRec_ProcMessageFail;
|
||||||
Procedure TestAdvRec_DestructorFail;
|
Procedure TestAdvRec_DestructorFail;
|
||||||
|
Procedure TestAdvRecordInFunction;
|
||||||
|
Procedure TestAdvRecordInAnonFunction;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TTestProcedureTypeParser }
|
{ TTestProcedureTypeParser }
|
||||||
@ -2607,6 +2609,53 @@ begin
|
|||||||
ParseRecordFail(SParserNoConstructorAllowed,nParserNoConstructorAllowed);
|
ParseRecordFail(SParserNoConstructorAllowed,nParserNoConstructorAllowed);
|
||||||
end;
|
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 }
|
{ TBaseTestTypeParser }
|
||||||
|
|
||||||
Function TBaseTestTypeParser.ParseType(ASource: String; ATypeClass: TClass;
|
Function TBaseTestTypeParser.ParseType(ASource: String; ATypeClass: TClass;
|
||||||
|
Loading…
Reference in New Issue
Block a user