+ add support for threadvars in records

+ added tests

git-svn-id: trunk@39289 -

.gitattributes

@@ -12887,6 +12887,8 @@ tests/test/terecs18.pp svneol=native#text/pascal
 tests/test/terecs18a.pp svneol=native#text/pascal
 tests/test/terecs19.pp svneol=native#text/pascal
 tests/test/terecs2.pp svneol=native#text/pascal
+tests/test/terecs20.pp svneol=native#text/pascal
+tests/test/terecs21.pp svneol=native#text/pascal
 tests/test/terecs3.pp svneol=native#text/pascal
 tests/test/terecs4.pp svneol=native#text/pascal
 tests/test/terecs5.pp svneol=native#text/pascal

compiler/ptype.pas

@@ -675,7 +675,7 @@ implementation
         oldparse_only: boolean;
         member_blocktype : tblock_type;
         hadgeneric,
-        fields_allowed, is_classdef, classfields: boolean;
+        fields_allowed, is_classdef, classfields, threadvarfields: boolean;
         vdoptions: tvar_dec_options;
       begin
         { empty record declaration ? }
@@ -695,6 +695,7 @@ implementation
         is_classdef:=false;
         hadgeneric:=false;
         classfields:=false;
+        threadvarfields:=false;
         member_blocktype:=bt_general;
         repeat
           case token of
@@ -713,6 +714,22 @@ implementation
                 fields_allowed:=true;
                 member_blocktype:=bt_general;
                 classfields:=is_classdef;
+                threadvarfields:=false;
+                is_classdef:=false;
+              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;
+                consume(_THREADVAR);
+                fields_allowed:=true;
+                member_blocktype:=bt_general;
+                classfields:=is_classdef;
+                threadvarfields:=true;
                 is_classdef:=false;
               end;
             _CONST:
@@ -735,6 +752,7 @@ implementation
                        fields_allowed:=true;
                        is_classdef:=false;
                        classfields:=false;
+                       threadvarfields:=false;
                        member_blocktype:=bt_general;
                      end;
                    _PROTECTED :
@@ -746,6 +764,7 @@ implementation
                        fields_allowed:=true;
                        is_classdef:=false;
                        classfields:=false;
+                       threadvarfields:=false;
                        member_blocktype:=bt_general;
                      end;
                    _PUBLIC :
@@ -755,6 +774,7 @@ implementation
                        fields_allowed:=true;
                        is_classdef:=false;
                        classfields:=false;
+                       threadvarfields:=false;
                        member_blocktype:=bt_general;
                      end;
                    _PUBLISHED :
@@ -765,6 +785,7 @@ implementation
                        fields_allowed:=true;
                        is_classdef:=false;
                        classfields:=false;
+                       threadvarfields:=false;
                        member_blocktype:=bt_general;
                      end;
                    _STRICT :
@@ -796,6 +817,7 @@ implementation
                         fields_allowed:=true;
                         is_classdef:=false;
                         classfields:=false;
+                        threadvarfields:=false;
                         member_blocktype:=bt_general;
                      end
                     else
@@ -829,6 +851,8 @@ implementation
                                   include(vdoptions,vd_class);
                                 if not (m_delphi in current_settings.modeswitches) then
                                   include(vdoptions,vd_check_generic);
+                                if threadvarfields then
+                                  include(vdoptions,vd_threadvar);
                                 read_record_fields(vdoptions,nil,nil,hadgeneric);
                               end;
                           end
@@ -857,7 +881,7 @@ implementation
                 { class modifier is only allowed for procedures, functions, }
                 { constructors, destructors, fields and properties          }
                 if (hadgeneric and not (token in [_FUNCTION,_PROCEDURE])) or
-                    (not hadgeneric and (not ((token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR,_DESTRUCTOR,_OPERATOR]) or (token=_CONSTRUCTOR)) and
+                    (not hadgeneric and (not ((token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR,_DESTRUCTOR,_OPERATOR,_THREADVAR]) or (token=_CONSTRUCTOR)) and
                    not((token=_ID) and (idtoken=_OPERATOR)))) then
                   Message(parser_e_procedure_or_function_expected);
 

tests/test/terecs20.pp

@@ -0,0 +1,39 @@
+{ %SKIPTARGET=$nothread }
+program terecs20;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+{$ifdef unix}
+uses
+  cthreads;
+{$endif}
+
+type
+  TTest = record
+  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/terecs21.pp

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