diff --git a/.gitattributes b/.gitattributes index baff62353b..d8678f641c 100644 --- a/.gitattributes +++ b/.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 diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index 3adb0be8f9..1e41f98a70 100644 --- a/compiler/pdecobj.pas +++ b/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 diff --git a/tests/test/tclass16.pp b/tests/test/tclass16.pp new file mode 100644 index 0000000000..97d50f30b6 --- /dev/null +++ b/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. + diff --git a/tests/test/tclass17.pp b/tests/test/tclass17.pp new file mode 100644 index 0000000000..37da518adb --- /dev/null +++ b/tests/test/tclass17.pp @@ -0,0 +1,14 @@ +{ %FAIL } + +program tclass17; + +{$mode objfpc} + +type + TTest = class + public threadvar + Test: LongInt; + end; + +begin +end.