compiler: fix parsing and handling of typed constants declared inside classes/objects + tests

git-svn-id: trunk@15094 -
This commit is contained in:
paul 2010-03-30 07:09:44 +00:00
parent 1ef53ca590
commit c879230f08
7 changed files with 76 additions and 7 deletions

2
.gitattributes vendored
View File

@ -8943,6 +8943,7 @@ tests/test/tclass11b.pp svneol=native#text/pascal
tests/test/tclass12a.pp svneol=native#text/pascal tests/test/tclass12a.pp svneol=native#text/pascal
tests/test/tclass12b.pp svneol=native#text/pascal tests/test/tclass12b.pp svneol=native#text/pascal
tests/test/tclass12c.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/tclass13.pp svneol=native#text/pascal
tests/test/tclass14a.pp svneol=native#text/pascal tests/test/tclass14a.pp svneol=native#text/pascal
tests/test/tclass14b.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/tobject4.pp svneol=native#text/plain
tests/test/tobject5.pp svneol=native#text/pascal tests/test/tobject5.pp svneol=native#text/pascal
tests/test/tobject6.pp svneol=native#text/plain 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/toperator1.pp svneol=native#text/plain
tests/test/toperator2.pp svneol=native#text/plain tests/test/toperator2.pp svneol=native#text/plain
tests/test/toperator3.pp svneol=native#text/plain tests/test/toperator3.pp svneol=native#text/plain

View File

@ -254,7 +254,7 @@ implementation
tclist:=current_asmdata.asmlists[al_rotypedconsts] tclist:=current_asmdata.asmlists[al_rotypedconsts]
else else
tclist:=current_asmdata.asmlists[al_typedconsts]; tclist:=current_asmdata.asmlists[al_typedconsts];
read_typed_const(tclist,tstaticvarsym(sym)); read_typed_const(tclist,tstaticvarsym(sym),in_class);
end; end;
end; end;

View File

@ -999,11 +999,11 @@ implementation
include(tcsym.symoptions,sp_internal); include(tcsym.symoptions,sp_internal);
vs.defaultconstsym:=tcsym; vs.defaultconstsym:=tcsym;
symtablestack.top.insert(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; end;
staticvarsym : staticvarsym :
begin begin
read_typed_const(current_asmdata.asmlists[al_typedconsts],tstaticvarsym(vs)); read_typed_const(current_asmdata.asmlists[al_typedconsts],tstaticvarsym(vs),false);
end; end;
else else
internalerror(200611051); internalerror(200611051);

View File

@ -1285,6 +1285,12 @@ implementation
begin begin
p1.free; p1.free;
p1:=genconstsymtree(tconstsym(sym)); p1:=genconstsymtree(tconstsym(sym));
end;
staticvarsym:
begin
// typed constant is a staticvarsym
p1.free;
p1:=cloadnode.create(sym,sym.Owner);
end end
else else
internalerror(16); internalerror(16);
@ -1531,7 +1537,7 @@ implementation
begin begin
check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
if not(getaddr) and 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) Message(sym_e_only_static_in_static)
else else
begin begin

View File

@ -27,7 +27,7 @@ interface
uses symtype,symsym,aasmdata; uses symtype,symsym,aasmdata;
procedure read_typed_const(list:tasmlist;sym:tstaticvarsym); procedure read_typed_const(list:tasmlist;sym:tstaticvarsym;in_class:boolean);
implementation implementation
@ -1375,7 +1375,7 @@ implementation
{$maxfpuregisters default} {$maxfpuregisters default}
procedure read_typed_const(list:tasmlist;sym:tstaticvarsym); procedure read_typed_const(list:tasmlist;sym:tstaticvarsym;in_class:boolean);
var var
storefilepos : tfileposinfo; storefilepos : tfileposinfo;
cursectype : TAsmSectionType; cursectype : TAsmSectionType;
@ -1407,7 +1407,8 @@ implementation
consume(_SEMICOLON); consume(_SEMICOLON);
{ parse public/external/export/... } { parse public/external/export/... }
if ( if not in_class and
(
( (
(token = _ID) and (token = _ID) and
(idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) and (idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) and

30
tests/test/tclass12d.pp Normal file
View File

@ -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.

30
tests/test/tobject7.pp Normal file
View File

@ -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.