paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-24 10:49:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

compiler: fix static fields creation and access for records

Browse Source 
+ extend test to check class constructor/destructor for records and static fields access

git-svn-id: branches/paul/extended_records@16545 -
This commit is contained in:
paul 2010-12-11 07:48:13 +00:00
parent 7852295f26
commit 52cd624a76
4 changed files with 39 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
compiler/pdecvar.pas
View File

@ -1530,25 +1530,25 @@ implementation
consume(_SEMICOLON); consume(_SEMICOLON);
include(options, vd_class); include(options, vd_class);
end; end;
if vd_class in options then end;
begin if vd_class in options then
{ add static flag and staticvarsyms } begin
for i:=0 to sc.count-1 do { add static flag and staticvarsyms }
begin for i:=0 to sc.count-1 do
fieldvs:=tfieldvarsym(sc[i]); begin
include(fieldvs.symoptions,sp_static); fieldvs:=tfieldvarsym(sc[i]);
{ generate the symbol which reserves the space } include(fieldvs.symoptions,sp_static);
static_name:=lower(generate_nested_name(recst,'_'))+'_'+fieldvs.name; { generate the symbol which reserves the space }
hstaticvs:=tstaticvarsym.create('$_static_'+static_name,vs_value,hdef,[]); static_name:=lower(generate_nested_name(recst,'_'))+'_'+fieldvs.name;
include(hstaticvs.symoptions,sp_internal); hstaticvs:=tstaticvarsym.create('$_static_'+static_name,vs_value,hdef,[]);
recst.get_unit_symtable.insert(hstaticvs); include(hstaticvs.symoptions,sp_internal);
insertbssdata(hstaticvs); recst.get_unit_symtable.insert(hstaticvs);
{ generate the symbol for the access } insertbssdata(hstaticvs);
sl:=tpropaccesslist.create; { generate the symbol for the access }
sl.addsym(sl_load,hstaticvs); sl:=tpropaccesslist.create;
recst.insert(tabsolutevarsym.create_ref('$'+static_name,hdef,sl)); sl.addsym(sl_load,hstaticvs);
end; recst.insert(tabsolutevarsym.create_ref('$'+static_name,hdef,sl));
end; end;
end; end;
if (visibility=vis_published) and if (visibility=vis_published) and
not(is_class(hdef)) then not(is_class(hdef)) then

5
compiler/pexpr.pas
View File

@ -1241,7 +1241,10 @@ implementation
if (sp_static in sym.symoptions) then if (sp_static in sym.symoptions) then
begin begin
static_name:=lower(generate_nested_name(sym.owner,'_'))+'_'+sym.name; static_name:=lower(generate_nested_name(sym.owner,'_'))+'_'+sym.name;
searchsym_in_class(tobjectdef(sym.owner.defowner),tobjectdef(sym.owner.defowner),static_name,sym,srsymtable); if sym.Owner.defowner.typ=objectdef then
searchsym_in_class(tobjectdef(sym.owner.defowner),tobjectdef(sym.owner.defowner),static_name,sym,srsymtable)
else
searchsym_in_record(trecorddef(sym.owner.defowner),static_name,sym,srsymtable);
if assigned(sym) then if assigned(sym) then
check_hints(sym,sym.symoptions,sym.deprecatedmsg); check_hints(sym,sym.symoptions,sym.deprecatedmsg);
p1.free; p1.free;

2
tests/test/terecs3.pp
View File

@ -21,5 +21,7 @@ begin
halt(4); halt(4);
if F.Test1(4) <> 5 then if F.Test1(4) <> 5 then
halt(5); halt(5);
if F.F5 <> 6 then
halt(6);
WriteLn('ok'); WriteLn('ok');
end. end.

16
tests/test/terecs_u1.pp
View File

@ -4,7 +4,6 @@ unit terecs_u1;
{$mode delphi} {$mode delphi}
interface interface
type type
HWND = integer; HWND = integer;
TFoo = record TFoo = record
@ -20,8 +19,12 @@ type
var var
F3: TBar; F3: TBar;
F4: Byte; F4: Byte;
class var
F5: TBar;
function Test(n: TBar): TBar; function Test(n: TBar): TBar;
class function Test1(n: TBar): TBar; class function Test1(n: TBar): TBar;
class constructor Create;
class destructor Destroy;
end; end;
implementation implementation
@ -36,5 +39,14 @@ begin
Result := C + n; Result := C + n;
end; end;
end. class constructor TFoo.Create;
begin
F5 := 6;
end;
class destructor TFoo.Destroy;
begin
WriteLn('TFoo.Destroy');
end;
end.