+ add support for threadvars inside classes

+ added tests

git-svn-id: trunk@39288 -

.gitattributes

@@ -12757,6 +12757,8 @@ tests/test/tclass13d.pp svneol=native#text/pascal
 tests/test/tclass14a.pp svneol=native#text/pascal
 tests/test/tclass14b.pp svneol=native#text/pascal
 tests/test/tclass15.pp svneol=native#text/pascal
+tests/test/tclass16.pp svneol=native#text/pascal
+tests/test/tclass17.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

compiler/pdecobj.pas

@@ -1043,7 +1043,8 @@ implementation
         typedconstswritable: boolean;
         object_member_blocktype : tblock_type;
         hadgeneric,
-        fields_allowed, is_classdef, class_fields, is_final, final_fields: boolean;
+        fields_allowed, is_classdef, class_fields, is_final, final_fields,
+        threadvar_fields : boolean;
         vdoptions: tvar_dec_options;
         fieldlist: tfpobjectlist;
 
@@ -1059,18 +1060,22 @@ implementation
         end;
 
 
-      procedure parse_var;
+      procedure parse_var(isthreadvar:boolean);
         begin
           if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper,odt_javaclass]) and
              { Java interfaces can contain static final class vars }
              not((current_objectdef.objecttype=odt_interfacejava) and
                  is_final and is_classdef) then
             Message(parser_e_type_var_const_only_in_records_and_classes);
-          consume(_VAR);
+          if isthreadvar then
+            consume(_THREADVAR)
+          else
+            consume(_VAR);
           fields_allowed:=true;
           object_member_blocktype:=bt_general;
           class_fields:=is_classdef;
           final_fields:=is_final;
+          threadvar_fields:=isthreadvar;
           is_classdef:=false;
           is_final:=false;
         end;
@@ -1083,7 +1088,7 @@ implementation
           consume(_CLASS);
           { class modifier is only allowed for procedures, functions, }
           { constructors, destructors, fields and properties          }
-          if not((token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR,_DESTRUCTOR]) or (token=_CONSTRUCTOR)) then
+          if not((token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR,_DESTRUCTOR,_THREADVAR]) or (token=_CONSTRUCTOR)) then
             Message(parser_e_procedure_or_function_expected);
 
           { Java interfaces can contain final class vars }
@@ -1117,6 +1122,7 @@ implementation
           fields_allowed:=true;
           is_classdef:=false;
           class_fields:=false;
+          threadvar_fields:=false;
           is_final:=false;
           object_member_blocktype:=bt_general;
         end;
@@ -1139,6 +1145,7 @@ implementation
         is_final:=false;
         final_fields:=false;
         hadgeneric:=false;
+        threadvar_fields:=false;
         object_member_blocktype:=bt_general;
         fieldlist:=tfpobjectlist.create(false);
         repeat
@@ -1152,12 +1159,22 @@ implementation
               end;
             _VAR :
               begin
-                parse_var;
+                parse_var(false);
               end;
             _CONST:
               begin
                 parse_const
               end;
+            _THREADVAR :
+              begin
+                if not is_classdef then
+                  begin
+                    Message(parser_e_threadvar_must_be_class);
+                    { for error recovery we enforce class fields }
+                    is_classdef:=true;
+                  end;
+                parse_var(true);
+              end;
             _ID :
               begin
                 if is_objcprotocol(current_structdef) and
@@ -1215,6 +1232,7 @@ implementation
                         fields_allowed:=true;
                         is_classdef:=false;
                         class_fields:=false;
+                        threadvar_fields:=false;
                         is_final:=false;
                         final_fields:=false;
                         object_member_blocktype:=bt_general;
@@ -1277,6 +1295,8 @@ implementation
                                   include(vdoptions,vd_canreorder);
                                 if final_fields then
                                   include(vdoptions,vd_final);
+                                if threadvar_fields then
+                                  include(vdoptions,vd_threadvar);
                                 read_record_fields(vdoptions,fieldlist,nil,hadgeneric);
                               end;
                           end

tests/test/tclass16.pp

@@ -0,0 +1,38 @@
+{ %SKIPTARGET=$nothread }
+program tclass16;
+
+{$mode objfpc}
+
+{$ifdef unix}
+uses
+  cthreads;
+{$endif}
+
+type
+  TTest = class
+  public class threadvar
+    Test: LongInt;
+  end;
+
+function TestFunc(aData: Pointer): PtrInt;
+var
+  e: PRTLEvent;
+begin
+  e := PRTLEvent(aData);
+  TTest.Test := 42;
+  RTLeventSetEvent(e);
+  Result := 0;
+end;
+
+var
+  e: PRTLEvent;
+begin
+  TTest.Test := 21;
+  e := RTLEventCreate;
+  BeginThread(@TestFunc, e);
+  RTLeventWaitFor(e);
+  if TTest.Test <> 21 then
+    Halt(1);
+  Writeln('Ok');
+end.
+

tests/test/tclass17.pp

@@ -0,0 +1,14 @@
+{ %FAIL }
+
+program tclass17;
+
+{$mode objfpc}
+
+type
+  TTest = class
+  public threadvar
+    Test: LongInt;
+  end;
+
+begin
+end.