compiler: implement 'var' and 'class var' sections for classes + tests

git-svn-id: trunk@14598 -

compiler/pdecobj.pas

@@ -526,7 +526,7 @@ implementation
         oldparse_only,
         old_parse_generic : boolean;
         object_member_blocktype : tblock_type;
-        fields_allowed, is_classdef: boolean;
+        fields_allowed, is_classdef, classfields: boolean;
       begin
         { empty class declaration ? }
         if (current_objectdef.objecttype in [odt_class,odt_objcclass]) and
@@ -545,6 +545,7 @@ implementation
         has_destructor:=false;
         fields_allowed:=true;
         is_classdef:=false;
+        classfields:=false;
         object_member_blocktype:=bt_general;
         repeat
           case token of
@@ -557,10 +558,14 @@ implementation
               end;
             _VAR :
               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(_VAR);
+                fields_allowed:=true;
                 object_member_blocktype:=bt_general;
+                classfields:=is_classdef;
+                is_classdef:=false;
               end;
             _ID :
               begin
@@ -659,7 +664,10 @@ implementation
                             if (not fields_allowed) then
                               Message(parser_e_field_not_allowed_here);
 
-                            read_record_fields([vd_object])
+                            if classfields then
+                              read_record_fields([vd_object,vd_class])
+                            else
+                              read_record_fields([vd_object])
                           end
                         else
                           types_dec;
@@ -679,7 +687,7 @@ implementation
                 if try_to_consume(_CLASS) then
                  begin
                    { class method only allowed for procedures and functions }
-                   if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY]) then
+                   if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR]) then
                      Message(parser_e_procedure_or_function_expected);
 
                    if is_interface(current_objectdef) then

compiler/pdecvar.pas

@@ -30,7 +30,7 @@ interface
       symsym,symdef;
 
     type
-      tvar_dec_option=(vd_record,vd_object,vd_threadvar);
+      tvar_dec_option=(vd_record,vd_object,vd_threadvar,vd_class);
       tvar_dec_options=set of tvar_dec_option;
 
     function  read_property_dec(is_classproperty:boolean; aclass:tobjectdef):tpropertysym;
@@ -1466,27 +1466,33 @@ implementation
                 (hdef.typesym=nil) then
                handle_calling_convention(tprocvardef(hdef));
 
-             { Check for STATIC directive }
-             if (vd_object in options) and                
-                (try_to_consume(_STATIC)) then
+             { check if it is a class field }
+             if (vd_object in options) then
                begin
-                 { add static flag and staticvarsyms }
-                 for i:=0 to sc.count-1 do
+                 { if it is not a class var section and token=STATIC then it is a class field too }
+                 if not (vd_class in options) and try_to_consume(_STATIC) then
                    begin
-                     fieldvs:=tfieldvarsym(sc[i]);
-                     include(fieldvs.symoptions,sp_static);
-                     { generate the symbol which reserves the space }
-                     hstaticvs:=tstaticvarsym.create('$_static_'+lower(symtablestack.top.name^)+'_'+fieldvs.name,vs_value,hdef,[]);
-                     recst.defowner.owner.insert(hstaticvs);
-                     insertbssdata(hstaticvs);
-                     { generate the symbol for the access }
-                     sl:=tpropaccesslist.create;
-                     sl.addsym(sl_load,hstaticvs);
-                     recst.insert(tabsolutevarsym.create_ref('$'+lower(symtablestack.top.name^)+'_'+fieldvs.name,hdef,sl));
+                     consume(_SEMICOLON);
+                     include(options, vd_class);
                    end;
-                 consume(_SEMICOLON);
+                 if vd_class in options then
+                 begin
+                   { add static flag and staticvarsyms }
+                   for i:=0 to sc.count-1 do
+                     begin
+                       fieldvs:=tfieldvarsym(sc[i]);
+                       include(fieldvs.symoptions,sp_static);
+                       { generate the symbol which reserves the space }
+                       hstaticvs:=tstaticvarsym.create('$_static_'+lower(symtablestack.top.name^)+'_'+fieldvs.name,vs_value,hdef,[]);
+                       recst.defowner.owner.insert(hstaticvs);
+                       insertbssdata(hstaticvs);
+                       { generate the symbol for the access }
+                       sl:=tpropaccesslist.create;
+                       sl.addsym(sl_load,hstaticvs);
+                       recst.insert(tabsolutevarsym.create_ref('$'+lower(symtablestack.top.name^)+'_'+fieldvs.name,hdef,sl));
+                     end;
+                 end;
                end;
-
              if (visibility=vis_published) and
                 not(is_class(hdef)) then
                begin

compiler/psub.pas

@@ -1737,7 +1737,7 @@ implementation
                   if try_to_consume(_CLASS) then
                    begin
                      { class method only allowed for procedures and functions }
-                     if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY]) then
+                     if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR]) then
                        Message(parser_e_procedure_or_function_expected);
 
                      if is_interface(current_objectdef) then

tests/test/tstatic1.pp

@@ -7,7 +7,8 @@ program tstatic1;
 type
   TSomeClass = class
   private
-    {$ifndef fpc}class var{$endif}FSomethingStatic: Integer; {$ifdef fpc}static;{$endif}
+    class var 
+      FSomethingStatic: Integer;
   public
     class procedure SomeClassMethod(A: Integer);
     class procedure SomeStaticMethod(A: Integer); static;

tests/test/tstatic2.pp

@@ -7,7 +7,8 @@ program tstatic2;
 type
   TSomeClass = class
   private
-    {$ifndef fpc}class var{$endif}FSomethingStatic: Integer; {$ifdef fpc}static;{$endif}
+    class var
+      FSomethingStatic: Integer;
   public
     class procedure SetSomethingStatic(AValue: Integer); static;
     class property SomethingStatic: Integer read FSomethingStatic write SetSomethingStatic;

tests/test/tstatic3.pp

@@ -8,8 +8,8 @@ program tstatic3;
 type
   TSomeClass = class
   private
-    {$ifndef fpc}class var{$endif}FSomethingStatic: Integer;
-    {$ifndef fpc}var{$endif} FSomethingRegular: Integer;
+    class var FSomethingStatic: Integer;
+    var FSomethingRegular: Integer;
     class procedure SetSomethingStatic(AValue: Integer); static;
   public
     class property SomethingStatic: Integer read FSomethingStatic write SetSomethingStatic;