fcl-passrc: resolver: allow anonymous records only for var, const and variants

(cherry picked from commit 3317078ae121ed1462a4033242e6edccf25f9dde)

packages/fcl-passrc/src/pasresolver.pp

@@ -12254,10 +12254,23 @@ end;
 procedure TPasResolver.AddRecordType(El: TPasRecordType; TypeParams: TFPList);
 var
   Scope: TPasRecordScope;
+  C: TClass;
 begin
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.AddRecordType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
   {$ENDIF}
+  if (El.Name='') then
+    begin
+    // anonymous record
+    C:=El.Parent.ClassType;
+    if (C=TPasVariable)
+        or (C=TPasConst)
+        or (C=TPasVariant) then
+      // ok
+    else
+      RaiseMsg(20220321224331,nCannotNestAnonymousX,sCannotNestAnonymousX,['record'],El);
+    end;
+
   if TypeParams<>nil then
     begin
     El.SetGenericTemplates(TypeParams);

packages/fcl-passrc/tests/tcresolver.pas

@@ -538,6 +538,17 @@ type
     Procedure TestAdvRecord_InFunctionFail;
     Procedure TestAdvRecord_SubClass;
 
+    // anonymous record
+    Procedure TestRecordAnonym_ResultTypeFail;
+    Procedure TestRecordAnonym_ArgumentFail;
+    Procedure TestRecordAnonym_Advanced_ConstFail;
+    Procedure TestRecordAnonym_Advanced_MethodFail;
+    Procedure TestRecordAnonym_Advanced_TypeFail;
+    Procedure TestRecordAnonym_Advanced_PropertyFail;
+    Procedure TestRecordAnonym_Var;
+    Procedure TestRecordAnonym_Nested;
+    Procedure TestRecordAnonym_Advanced_Visibility;
+
     // class
     Procedure TestClass;
     Procedure TestClassDefaultInheritance;
@@ -891,6 +902,7 @@ type
     Procedure TestProcType_PassProcToUntyped;
 
     // anonymous procedure type
+    Procedure TestProcTypeAnonymous_Var;
     Procedure TestProcTypeAnonymous_FunctionFunctionFail;
     Procedure TestProcTypeAnonymous_ResultTypeFail;
     Procedure TestProcTypeAnonymous_ArgumentFail;
@@ -9125,6 +9137,144 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestRecordAnonym_ResultTypeFail;
+begin
+  StartProgram(false);
+  Add([
+  'function Fly: record',
+  '    x: word;',
+  '  end;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('Cannot nest anonymous record',nCannotNestAnonymousX);
+end;
+
+procedure TTestResolver.TestRecordAnonym_ArgumentFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure Fly(const r: record',
+  '    x: word;',
+  '  end);',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('Cannot nest anonymous record',nCannotNestAnonymousX);
+end;
+
+procedure TTestResolver.TestRecordAnonym_Advanced_ConstFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch AdvancedRecords}',
+  'var',
+  '  r: record',
+  '    const c = 3;',
+  '    var x: word;',
+  '  end;',
+  'begin',
+  '']);
+  CheckParserException(SErrRecordConstantsNotAllowed,nErrRecordConstantsNotAllowed);
+end;
+
+procedure TTestResolver.TestRecordAnonym_Advanced_MethodFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch AdvancedRecords}',
+  'var',
+  '  r: record',
+  '    procedure Fly;',
+  '  end;',
+  'begin',
+  '']);
+  CheckParserException(SErrRecordMethodsNotAllowed,nErrRecordMethodsNotAllowed);
+end;
+
+procedure TTestResolver.TestRecordAnonym_Advanced_TypeFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch AdvancedRecords}',
+  'var',
+  '  r: record',
+  '    type TFlag = word;',
+  '  end;',
+  'begin',
+  '']);
+  CheckParserException(SErrRecordTypesNotAllowed,nErrRecordTypesNotAllowed);
+end;
+
+procedure TTestResolver.TestRecordAnonym_Advanced_PropertyFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch AdvancedRecords}',
+  'var',
+  '  r: record',
+  '    FSize: word;',
+  '    property Size: word read FSize;',
+  '  end;',
+  'begin',
+  '']);
+  CheckParserException(SErrRecordPropertiesNotAllowed,nErrRecordPropertiesNotAllowed);
+end;
+
+procedure TTestResolver.TestRecordAnonym_Var;
+begin
+  StartProgram(false);
+  Add([
+  'var',
+  '  r: record',
+  '    x: word;',
+  '  end;',
+  'begin',
+  '  r.x:=3;',
+  '  r.x:=r.x + 4;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestRecordAnonym_Nested;
+begin
+  StartProgram(false);
+  Add([
+  'var',
+  '  r: record',
+  '    p: record',
+  '      x: word;',
+  '    end;',
+  '  end;',
+  'begin',
+  '  r.p.x:=3;',
+  '  r.p.x:=r.p.x + 4;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestRecordAnonym_Advanced_Visibility;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch AdvancedRecords}',
+  'var',
+  '  r: record',
+  '    private',
+  '      Size: word;',
+  '    public',
+  '      Color: word;',
+  '  end;',
+  'begin',
+  '  r.Size:=3;',
+  '  r.Size:=r.Size+4;',
+  '  r.Color:=r.Color+5;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestClass;
 begin
   StartProgram(false);
@@ -16527,6 +16677,16 @@ begin
     end;
 end;
 
+procedure TTestResolver.TestProcTypeAnonymous_Var;
+begin
+  StartProgram(false);
+  Add([
+  'var',
+  '  f: function: word;',
+  'begin']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestProcTypeAnonymous_FunctionFunctionFail;
 begin
   StartProgram(false);