From 973d947d6cee57ae37e16dcaa7ddc616170f18e7 Mon Sep 17 00:00:00 2001 From: paul Date: Tue, 30 Mar 2010 04:22:19 +0000 Subject: [PATCH] compiler: allow const, type, var and class var sections for objects + test git-svn-id: trunk@15092 - --- .gitattributes | 1 + compiler/pdecobj.pas | 6 +++--- compiler/pdecvar.pas | 5 ++--- compiler/pexpr.pas | 3 ++- compiler/symdef.pas | 9 ++++++++- compiler/symtable.pas | 4 ++-- tests/test/tobject6.pp | 38 ++++++++++++++++++++++++++++++++++++++ 7 files changed, 56 insertions(+), 10 deletions(-) create mode 100644 tests/test/tobject6.pp diff --git a/.gitattributes b/.gitattributes index cd4b11d96a..718b1dfefc 100644 --- a/.gitattributes +++ b/.gitattributes @@ -9182,6 +9182,7 @@ tests/test/tobject2.pp svneol=native#text/plain tests/test/tobject3.pp svneol=native#text/plain tests/test/tobject4.pp svneol=native#text/plain tests/test/tobject5.pp svneol=native#text/pascal +tests/test/tobject6.pp svneol=native#text/plain tests/test/toperator1.pp svneol=native#text/plain tests/test/toperator2.pp svneol=native#text/plain tests/test/toperator3.pp svneol=native#text/plain diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index 5bc81fc08a..c70414ffa8 100644 --- a/compiler/pdecobj.pas +++ b/compiler/pdecobj.pas @@ -552,7 +552,7 @@ implementation _TYPE : begin if (([df_generic,df_specialization]*current_objectdef.defoptions)=[]) and - (current_objectdef.objecttype<>odt_class) then + not(current_objectdef.objecttype in [odt_class,odt_object]) then Message(parser_e_type_var_const_only_in_generics_and_classes); consume(_TYPE); object_member_blocktype:=bt_type; @@ -560,7 +560,7 @@ implementation _VAR : begin if (([df_generic,df_specialization]*current_objectdef.defoptions)=[]) and - (current_objectdef.objecttype<>odt_class) then + not(current_objectdef.objecttype in [odt_class,odt_object]) then Message(parser_e_type_var_const_only_in_generics_and_classes); consume(_VAR); fields_allowed:=true; @@ -571,7 +571,7 @@ implementation _CONST: begin if (([df_generic,df_specialization]*current_objectdef.defoptions)=[]) and - (current_objectdef.objecttype<>odt_class) then + not(current_objectdef.objecttype in [odt_class,odt_object]) then Message(parser_e_type_var_const_only_in_generics_and_classes); consume(_CONST); object_member_blocktype:=bt_const; diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index b1670edece..d4e142a2ae 100644 --- a/compiler/pdecvar.pas +++ b/compiler/pdecvar.pas @@ -1413,12 +1413,11 @@ implementation { Don't search in the recordsymtable for types (can be nested!) } recstlist.count:=0; if ([df_generic,df_specialization]*tdef(recst.defowner).defoptions=[]) and - not is_class(tdef(recst.defowner)) then + not is_class_or_object(tdef(recst.defowner)) then begin recstlist.add(recst); symtablestack.pop(recst); - while (is_object(tdef(symtablestack.top.defowner)) or - (symtablestack.top.symtabletype=recordsymtable)) and + while (symtablestack.top.symtabletype=recordsymtable) and ([df_generic,df_specialization]*tdef(symtablestack.top.defowner).defoptions=[]) do begin recst:=tabstractrecordsymtable(symtablestack.top); diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index c2282a4148..a1f9786cbb 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -1530,7 +1530,8 @@ implementation if assigned(srsym) then begin check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); - if not(getaddr) and not(sp_static in srsym.symoptions) then + if not(getaddr) and + not((sp_static in srsym.symoptions) or (srsym.typ=constsym)) then Message(sym_e_only_static_in_static) else begin diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 8e163cf9c2..d765bdd7b8 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -758,6 +758,7 @@ interface function is_class_or_interface_or_object(def: tdef): boolean; function is_class_or_interface_or_dispinterface(def: tdef): boolean; function is_class_or_interface_or_dispinterface_or_objc(def: tdef): boolean; + function is_class_or_object(def: tdef): boolean; procedure loadobjctypes; @@ -4786,7 +4787,6 @@ implementation var def: tdef absolute data; pd: tprocdef absolute data; - founderrordef: tdef; i, paracount: longint; begin @@ -5351,6 +5351,13 @@ implementation (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol]); end; + function is_class_or_object(def: tdef): boolean; + begin + result:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype in [odt_class,odt_object]); + end; procedure loadobjctypes; begin diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 5a5e7e61a0..6d569edb99 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -1828,7 +1828,7 @@ implementation records objects parameters - Exception are classes, generic definitions and specializations + Exception are classes, objects, generic definitions and specializations that have the parameterized types inserted in the symtable. } srsymtable:=stackitem^.symtable; @@ -1837,7 +1837,7 @@ implementation ( (df_generic in tdef(srsymtable.defowner).defoptions) or (df_specialization in tdef(srsymtable.defowner).defoptions) or - is_class(tdef(srsymtable.defowner))) + is_class_or_object(tdef(srsymtable.defowner))) ) then begin srsym:=tsym(srsymtable.FindWithHash(hashedid)); diff --git a/tests/test/tobject6.pp b/tests/test/tobject6.pp new file mode 100644 index 0000000000..80bba62d56 --- /dev/null +++ b/tests/test/tobject6.pp @@ -0,0 +1,38 @@ +program tobject6; +{$APPTYPE console} +{$ifdef fpc} + {$mode delphi}{$H+} +{$endif} + +type + TR = object + private + type + tsometype = integer; + class var + ffield1: tsometype; + var + ffield2: string; + const + somevalue = 1; + class procedure SetField1(const Value: tsometype); static; + public + class property field1: tsometype read ffield1 write SetField1; + end; + +{ TR } + +class procedure TR.SetField1(const Value: tsometype); +begin + ffield1 := Value; +end; + +begin + TR.field1 := 10; + if TR.field1 <> 10 then + halt(1); + WriteLn(TR.somevalue); + if TR.somevalue <> 1 then + halt(2); + WriteLn('ok'); +end.