compiler: allow class to have local type sections + tests

git-svn-id: trunk@14605 -

.gitattributes

@@ -8889,6 +8889,7 @@ tests/test/tcase9.pp svneol=native#text/pascal
 tests/test/tcg1.pp svneol=native#text/plain
 tests/test/tcint64.pp svneol=native#text/plain
 tests/test/tclass1.pp svneol=native#text/plain
+tests/test/tclass10.pp svneol=native#text/pascal
 tests/test/tclass2.pp svneol=native#text/plain
 tests/test/tclass3.pp svneol=native#text/plain
 tests/test/tclass4.pp svneol=native#text/plain
@@ -8896,6 +8897,7 @@ tests/test/tclass5.pp svneol=native#text/plain
 tests/test/tclass6.pp svneol=native#text/plain
 tests/test/tclass7.pp svneol=native#text/plain
 tests/test/tclass8.pp svneol=native#text/plain
+tests/test/tclass9.pp svneol=native#text/pascal
 tests/test/tclassinfo1.pp svneol=native#text/pascal
 tests/test/tclrprop.pp svneol=native#text/plain
 tests/test/tcmp.pp svneol=native#text/plain

compiler/pdecobj.pas

@@ -551,7 +551,8 @@ implementation
           case token of
             _TYPE :
               begin
-                if ([df_generic,df_specialization]*current_objectdef.defoptions)=[] then
+                if (([df_generic,df_specialization]*current_objectdef.defoptions)=[]) and
+                   (current_objectdef.objecttype<>odt_class) then
                   Message(parser_e_type_and_var_only_in_generics);
                  consume(_TYPE);
                  object_member_blocktype:=bt_type;

compiler/pdecvar.pas

@@ -1381,10 +1381,12 @@ implementation
              consume(_COLON);
 
              { Don't search in the recordsymtable for types }
-             if ([df_generic,df_specialization]*tdef(recst.defowner).defoptions=[]) then
+             if ([df_generic,df_specialization]*tdef(recst.defowner).defoptions=[]) and
+                not is_class(tdef(recst.defowner)) then
                symtablestack.pop(recst);
              read_anon_type(hdef,false);
-             if ([df_generic,df_specialization]*tdef(recst.defowner).defoptions=[]) then
+             if ([df_generic,df_specialization]*tdef(recst.defowner).defoptions=[]) and
+                not is_class(tdef(recst.defowner)) then
                symtablestack.push(recst);
 
              { Process procvar directives }

compiler/symtable.pas

@@ -1752,7 +1752,7 @@ implementation
                 records
                 objects
                 parameters
-              Exception are generic definitions and specializations
+              Exception are classes, generic definitions and specializations
               that have the parameterized types inserted in the symtable.
             }
             srsymtable:=stackitem^.symtable;
@@ -1760,7 +1760,8 @@ implementation
                (assigned(srsymtable.defowner) and
                 (
                  (df_generic in tdef(srsymtable.defowner).defoptions) or
-                 (df_specialization in tdef(srsymtable.defowner).defoptions))
+                 (df_specialization in tdef(srsymtable.defowner).defoptions) or
+                 is_class(tdef(srsymtable.defowner)))
                 ) then
               begin
                 srsym:=tsym(srsymtable.FindWithHash(hashedid));
@@ -1768,7 +1769,8 @@ implementation
                    not(srsym.typ in [fieldvarsym,paravarsym]) and
                    (
                     (srsym.owner.symtabletype<>objectsymtable) or
-                    is_visible_for_object(srsym,current_objectdef)
+                    (is_visible_for_object(srsym,current_objectdef) and
+                     (srsym.typ=typesym))
                    ) then
                   begin
                     { we need to know if a procedure references symbols

tests/tbf/tb0189.pp

@@ -1,4 +1,3 @@
-{ %fail }
 {$mode objfpc}
 
 type

tests/test/tclass10.pp

@@ -0,0 +1,24 @@
+program tclass10;
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+
+  { c }
+
+  c=class
+   type
+     TSomeType = (st1, st2);
+    function DoSomething: TSomeType;
+  end;
+
+{ c }
+
+function c.DoSomething: TSomeType;
+begin
+  Result := st1;
+end;
+
+begin
+end.

tests/test/tclass9.pp

@@ -0,0 +1,35 @@
+program tclass9;
+
+{$ifdef fpc}
+  {$mode delphi}{$H+}
+{$endif}
+{$APPTYPE CONSOLE}
+
+type
+  TSomeClass = class
+  private
+    type
+      TSomeType = type integer;    // an internal type
+    class var
+      FSomeClassVar: TSomeType;    // class variable belongs to class, not an instance
+    var
+      FSomeIntanceVar: TSomeType;  // instance variable belongs to instance. it is a usual field
+    class procedure SetSomeClassVar(const AValue: TSomeType); static;
+  public
+    class property SomeProperty: TSomeType read FSomeClassVar write SetSomeClassVar; // class property - belongs to class
+    property SomeInstanceProp: TSomeType read FSomeIntanceVar;
+  end;
+
+{ TSomeClass }
+
+class procedure TSomeClass.SetSomeClassVar(const AValue: TSomeType);
+begin
+   FSomeClassVar := AValue;
+end;
+
+var
+  SomeClass: TSomeClass;
+begin
+  SomeClass.SomeProperty := 1;
+  WriteLn(SomeClass.SomeProperty);
+end.