Browse Source

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

git-svn-id: trunk@43228 -
michael 5 years ago
parent
commit
06f0d7ce87
2 changed files with 57 additions and 2 deletions
  1. 8 2
      packages/fcl-passrc/src/pparser.pp
  2. 49 0
      packages/fcl-passrc/tests/tctypeparser.pas

+ 8 - 2
packages/fcl-passrc/src/pparser.pp

@@ -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,
-      (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);
     Engine.FinishScope(stTypeDef,Result);
     ok:=true;
     ok:=true;
   finally
   finally

+ 49 - 0
packages/fcl-passrc/tests/tctypeparser.pas

@@ -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;