mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 19:09:16 +02:00
compiler: fix parsing and handling of typed constants declared inside classes/objects + tests
git-svn-id: trunk@15094 -
This commit is contained in:
parent
1ef53ca590
commit
c879230f08
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -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
|
||||||
|
@ -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;
|
||||||
|
|
||||||
|
@ -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);
|
||||||
|
@ -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
|
||||||
|
@ -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
30
tests/test/tclass12d.pp
Normal 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
30
tests/test/tobject7.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user