From c879230f08612342136f1440acea358d4d0d1e3d Mon Sep 17 00:00:00 2001 From: paul Date: Tue, 30 Mar 2010 07:09:44 +0000 Subject: [PATCH] compiler: fix parsing and handling of typed constants declared inside classes/objects + tests git-svn-id: trunk@15094 - --- .gitattributes | 2 ++ compiler/pdecl.pas | 2 +- compiler/pdecvar.pas | 4 ++-- compiler/pexpr.pas | 8 +++++++- compiler/ptconst.pas | 7 ++++--- tests/test/tclass12d.pp | 30 ++++++++++++++++++++++++++++++ tests/test/tobject7.pp | 30 ++++++++++++++++++++++++++++++ 7 files changed, 76 insertions(+), 7 deletions(-) create mode 100644 tests/test/tclass12d.pp create mode 100644 tests/test/tobject7.pp diff --git a/.gitattributes b/.gitattributes index 718b1dfefc..828f319614 100644 --- a/.gitattributes +++ b/.gitattributes @@ -8943,6 +8943,7 @@ tests/test/tclass11b.pp svneol=native#text/pascal tests/test/tclass12a.pp svneol=native#text/pascal tests/test/tclass12b.pp svneol=native#text/pascal tests/test/tclass12c.pp svneol=native#text/pascal +tests/test/tclass12d.pp svneol=native#text/plain tests/test/tclass13.pp svneol=native#text/pascal tests/test/tclass14a.pp svneol=native#text/pascal tests/test/tclass14b.pp svneol=native#text/pascal @@ -9183,6 +9184,7 @@ 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/tobject7.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/pdecl.pas b/compiler/pdecl.pas index f35bc9fc04..e921441eda 100644 --- a/compiler/pdecl.pas +++ b/compiler/pdecl.pas @@ -254,7 +254,7 @@ implementation tclist:=current_asmdata.asmlists[al_rotypedconsts] else tclist:=current_asmdata.asmlists[al_typedconsts]; - read_typed_const(tclist,tstaticvarsym(sym)); + read_typed_const(tclist,tstaticvarsym(sym),in_class); end; end; diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index d4e142a2ae..960fadf206 100644 --- a/compiler/pdecvar.pas +++ b/compiler/pdecvar.pas @@ -999,11 +999,11 @@ implementation include(tcsym.symoptions,sp_internal); vs.defaultconstsym:=tcsym; symtablestack.top.insert(tcsym); - read_typed_const(current_asmdata.asmlists[al_typedconsts],tcsym); + read_typed_const(current_asmdata.asmlists[al_typedconsts],tcsym,false); end; staticvarsym : begin - read_typed_const(current_asmdata.asmlists[al_typedconsts],tstaticvarsym(vs)); + read_typed_const(current_asmdata.asmlists[al_typedconsts],tstaticvarsym(vs),false); end; else internalerror(200611051); diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index a1f9786cbb..94c3e548ac 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -1285,6 +1285,12 @@ implementation begin p1.free; p1:=genconstsymtree(tconstsym(sym)); + end; + staticvarsym: + begin + // typed constant is a staticvarsym + p1.free; + p1:=cloadnode.create(sym,sym.Owner); end else internalerror(16); @@ -1531,7 +1537,7 @@ implementation begin check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); if not(getaddr) and - not((sp_static in srsym.symoptions) or (srsym.typ=constsym)) then + not((sp_static in srsym.symoptions) or (srsym.typ in [constsym,staticvarsym])) then Message(sym_e_only_static_in_static) else begin diff --git a/compiler/ptconst.pas b/compiler/ptconst.pas index d0d85cd438..7d3758db0b 100644 --- a/compiler/ptconst.pas +++ b/compiler/ptconst.pas @@ -27,7 +27,7 @@ interface uses symtype,symsym,aasmdata; - procedure read_typed_const(list:tasmlist;sym:tstaticvarsym); + procedure read_typed_const(list:tasmlist;sym:tstaticvarsym;in_class:boolean); implementation @@ -1375,7 +1375,7 @@ implementation {$maxfpuregisters default} - procedure read_typed_const(list:tasmlist;sym:tstaticvarsym); + procedure read_typed_const(list:tasmlist;sym:tstaticvarsym;in_class:boolean); var storefilepos : tfileposinfo; cursectype : TAsmSectionType; @@ -1407,7 +1407,8 @@ implementation consume(_SEMICOLON); { parse public/external/export/... } - if ( + if not in_class and + ( ( (token = _ID) and (idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) and diff --git a/tests/test/tclass12d.pp b/tests/test/tclass12d.pp new file mode 100644 index 0000000000..38d720bd37 --- /dev/null +++ b/tests/test/tclass12d.pp @@ -0,0 +1,30 @@ +program tclass12d; +{$APPTYPE console} +{$ifdef fpc} + {$mode delphi}{$H+} +{$endif} + +type + TR = class + private + type + TSomeType = integer; + const + SomeValue: TSomeType = 1; + class function GetSomeProp: TSomeType; static; + public + class property SomeProp: TSomeType read GetSomeProp; + end; + +class function TR.GetSomeProp: TSomeType; +begin + Result := SomeValue; +end; + +begin + if TR.SomeValue <> 1 then + halt(1); + if TR.SomeProp <> 1 then + halt(1); + WriteLn('ok'); +end. diff --git a/tests/test/tobject7.pp b/tests/test/tobject7.pp new file mode 100644 index 0000000000..77a0b30349 --- /dev/null +++ b/tests/test/tobject7.pp @@ -0,0 +1,30 @@ +program tclass12d; +{$APPTYPE console} +{$ifdef fpc} + {$mode delphi}{$H+} +{$endif} + +type + TR = object + private + type + TSomeType = integer; + const + SomeValue: TSomeType = 1; + class function GetSomeProp: TSomeType; static; + public + class property SomeProp: TSomeType read GetSomeProp; + end; + +class function TR.GetSomeProp: TSomeType; +begin + Result := SomeValue; +end; + +begin + if TR.SomeValue <> 1 then + halt(1); + if TR.SomeProp <> 1 then + halt(1); + WriteLn('ok'); +end.