paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 07:09:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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/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

2
compiler/pdecl.pas
View File

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

4
compiler/pdecvar.pas
View File

@ -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);

8
compiler/pexpr.pas
View File

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

7
compiler/ptconst.pas
View File

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

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.