compiler: don't allow constants, methods, class members and properties for local or anonymous records (fixes bug #0023000)

git-svn-id: trunk@23421 -

.gitattributes

@@ -10798,7 +10798,15 @@ tests/test/terecs1.pp svneol=native#text/pascal
 tests/test/terecs10.pp svneol=native#text/pascal
 tests/test/terecs11.pp svneol=native#text/pascal
 tests/test/terecs12.pp svneol=native#text/pascal
+tests/test/terecs12a.pp svneol=native#text/pascal
+tests/test/terecs12b.pp svneol=native#text/pascal
+tests/test/terecs12c.pp svneol=native#text/pascal
+tests/test/terecs12d.pp svneol=native#text/pascal
 tests/test/terecs13.pp svneol=native#text/pascal
+tests/test/terecs13a.pp svneol=native#text/pascal
+tests/test/terecs13b.pp svneol=native#text/pascal
+tests/test/terecs13c.pp svneol=native#text/pascal
+tests/test/terecs13d.pp svneol=native#text/pascal
 tests/test/terecs14.pp svneol=native#text/pascal
 tests/test/terecs15.pp svneol=native#text/pascal
 tests/test/terecs16.pp svneol=native#text/pascal

compiler/msg/errore.msg

@@ -392,7 +392,7 @@ scan_w_setpeoptflags_not_support=02092_W_SETPEOPTFLAGS is not supported by the t
 #
 # Parser
 #
-# 03327 is the last used one
+# 03331 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1471,6 +1471,18 @@ parser_w_case_difference_auto_property_getter_setter_prefix=03327_W_Case mismatc
 % not can it add one using the correct case (it could conflict with the original declaration).
 % Manually correct the case of the getter/setter to conform to the desired coding rules.
 % \var{TChild} overrides
+parser_e_no_consts_in_local_anonymous_records=03328_E_Constants declarations are not allowed in local or anonymous records
+% Records with constants must be defined globally. Constants cannot be defined inside records which are defined in a
+% procedure or function or in anonymous records.
+parser_e_no_methods_in_local_anonymous_records=03329_E_Method declarations are not allowed in local or anonymous records
+% Records with methods must be defined globally. Methods cannot be defined inside records which are defined in a
+% procedure or function or in anonymous records.
+parser_e_no_properties_in_local_anonymous_records=03330_E_Property declarations are not allowed in local or anonymous records
+% Records with properties must be defined globally. Properties cannot be defined inside records which are defined in a
+% procedure or function or in anonymous records.
+parser_e_no_class_in_local_anonymous_records=03331_E_Class memeber declarations are not allowed in local or anonymous records
+% Records with class members must be defined globally. Class members cannot be defined inside records which are defined in a
+% procedure or function or in anonymous records.
 %
 % \end{description}
 %

compiler/msgidx.inc

@@ -423,6 +423,10 @@ const
   parser_e_cannot_generate_property_getter_setter=03325;
   parser_w_overriding_property_getter_setter=03326;
   parser_w_case_difference_auto_property_getter_setter_prefix=03327;
+  parser_e_no_consts_in_local_anonymous_records=03328;
+  parser_e_no_methods_in_local_anonymous_records=03329;
+  parser_e_no_properties_in_local_anonymous_records=03330;
+  parser_e_no_class_in_local_anonymous_records=03331;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -963,9 +967,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 68093;
+  MsgTxtSize = 68401;
 
   MsgIdxMax : array[1..20] of longint=(
-    26,93,328,120,87,56,126,26,202,63,
+    26,93,332,120,87,56,126,26,202,63,
     54,20,1,1,1,1,1,1,1,1
   );

compiler/ptype.pas

@@ -520,6 +520,13 @@ implementation
 
 
     procedure parse_record_members;
+
+      function IsAnonOrLocal: Boolean;
+        begin
+          result:=(current_structdef.objname^='') or
+                  not(symtablestack.stack^.next^.symtable.symtabletype in [globalsymtable,staticsymtable,objectsymtable,recordsymtable]);
+        end;
+
       var
         pd : tprocdef;
         oldparse_only: boolean;
@@ -544,8 +551,7 @@ implementation
                 member_blocktype:=bt_type;
 
                 { local and anonymous records can not have inner types. skip top record symtable }
-                if (current_structdef.objname^='') or
-                   not(symtablestack.stack^.next^.symtable.symtabletype in [globalsymtable,staticsymtable,objectsymtable,recordsymtable]) then
+                if IsAnonOrLocal then
                   Message(parser_e_no_types_in_local_anonymous_records);
               end;
             _VAR :
@@ -560,6 +566,10 @@ implementation
               begin
                 consume(_CONST);
                 member_blocktype:=bt_const;
+
+                { local and anonymous records can not have constants. skip top record symtable }
+                if IsAnonOrLocal then
+                  Message(parser_e_no_consts_in_local_anonymous_records);
               end;
             _ID, _CASE, _OPERATOR :
               begin
@@ -661,6 +671,8 @@ implementation
               end;
             _PROPERTY :
               begin
+                if IsAnonOrLocal then
+                  Message(parser_e_no_properties_in_local_anonymous_records);
                 struct_property_dec(is_classdef);
                 fields_allowed:=false;
                 is_classdef:=false;
@@ -676,17 +688,24 @@ implementation
                    not((token=_ID) and (idtoken=_OPERATOR)) then
                   Message(parser_e_procedure_or_function_expected);
 
+                if IsAnonOrLocal then
+                  Message(parser_e_no_class_in_local_anonymous_records);
+
                 is_classdef:=true;
               end;
             _PROCEDURE,
             _FUNCTION:
               begin
+                if IsAnonOrLocal then
+                  Message(parser_e_no_methods_in_local_anonymous_records);
                 pd:=parse_record_method_dec(current_structdef,is_classdef);
                 fields_allowed:=false;
                 is_classdef:=false;
               end;
             _CONSTRUCTOR :
               begin
+                if IsAnonOrLocal then
+                  Message(parser_e_no_methods_in_local_anonymous_records);
                 if not is_classdef and (current_structdef.symtable.currentvisibility <> vis_public) then
                   Message(parser_w_constructor_should_be_public);
 
@@ -707,6 +726,8 @@ implementation
               end;
             _DESTRUCTOR :
               begin
+                if IsAnonOrLocal then
+                  Message(parser_e_no_methods_in_local_anonymous_records);
                 if not is_classdef then
                   Message(parser_e_no_destructor_in_records);
 

compiler/symtable.pas

@@ -1955,9 +1955,14 @@ implementation
         while assigned(symtable) and (symtable.symtabletype in [ObjectSymtable,recordsymtable]) do
           begin
             if (result='') then
-              result:=symtable.name^
+              if symtable.name<>nil then
+                result:=symtable.name^
+              else
             else
-              result:=symtable.name^+delimiter+result;
+              if symtable.name<>nil then
+                result:=symtable.name^+delimiter+result
+              else
+                result:=delimiter+result;
             symtable:=symtable.defowner.owner;
           end;
       end;

tests/test/terecs12a.pp

@@ -0,0 +1,19 @@
+{ %FAIL }
+{ %NORUN }
+program terecs12a;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+procedure Test;
+type
+  TRecord = record
+  private const
+    TestConst = 0;
+  end;
+begin
+end;
+
+begin
+end.

tests/test/terecs12b.pp

@@ -0,0 +1,20 @@
+{ %FAIL }
+{ %NORUN }
+program terecs12b;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+procedure Test;
+type
+  TRecord = record
+  var
+    TestField: Integer;
+    property TestProperty: Integer read TestField;
+  end;
+begin
+end;
+
+begin
+end.

tests/test/terecs12c.pp

@@ -0,0 +1,19 @@
+{ %FAIL }
+{ %NORUN }
+program terecs12c;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+procedure Test;
+type
+  TRecord = record
+  class var
+    TestField: Integer;
+  end;
+begin
+end;
+
+begin
+end.

tests/test/terecs12d.pp

@@ -0,0 +1,18 @@
+{ %FAIL }
+{ %NORUN }
+program terecs12d;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+procedure Test;
+type
+  TRecord = record
+    procedure Test;
+  end;
+begin
+end;
+
+begin
+end.

tests/test/terecs13a.pp

@@ -0,0 +1,16 @@
+{ %FAIL }
+{ %NORUN }
+program terecs13a;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+var
+  R: record
+    private const
+      TestConst = 0;
+  end;
+
+begin
+end.

tests/test/terecs13b.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+{ %NORUN }
+program terecs13b;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+var
+  R: record
+    var
+      TestField: Integer;
+      property TestProperty: Integer read TestField;
+  end;
+
+begin
+end.

tests/test/terecs13c.pp

@@ -0,0 +1,16 @@
+{ %FAIL }
+{ %NORUN }
+program terecs13c;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+var
+  R: record
+    class var
+      TestField: Integer;
+  end;
+
+begin
+end.

tests/test/terecs13d.pp

@@ -0,0 +1,15 @@
+{ %FAIL }
+{ %NORUN }
+program terecs13d;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+var
+  R: record
+    procedure Test;
+  end;
+
+begin
+end.