mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 11:29:27 +02:00
Fix for Mantis #19697. For this we need to have the internal static var symbol know that it came from a static field var symbol so that we can check that for generic or not.
symsym.pas, tfieldvarsym: + add new field fieldvarsym which holds a reference to a tfieldvarsym if the static sym was created based on such a symbol + add necessary methods and code to correctly load from and store to PPU + add new constructor create_from_fieldvar symcreat.pas, make_field_static: * use new create_from_fieldvar constructor instead of the default one hlcgobj.pas, finalize_static_data: * check whether the static var is based on a generic's class var ppu.pas: * increase PPU version + added test git-svn-id: trunk@27466 -
This commit is contained in:
parent
c5050ea645
commit
5c1b8fdad9
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -13578,6 +13578,7 @@ tests/webtbs/tw19610.pp svneol=native#text/plain
|
||||
tests/webtbs/tw19622.pp svneol=native#text/plain
|
||||
tests/webtbs/tw1964.pp svneol=native#text/plain
|
||||
tests/webtbs/tw19651.pp svneol=native#text/plain
|
||||
tests/webtbs/tw19697.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw19700.pp svneol=native#text/plain
|
||||
tests/webtbs/tw19701.pas svneol=native#text/plain
|
||||
tests/webtbs/tw19851a.pp svneol=native#text/pascal
|
||||
@ -14632,6 +14633,7 @@ tests/webtbs/uw18087b.pp svneol=native#text/pascal
|
||||
tests/webtbs/uw18909a.pp svneol=native#text/pascal
|
||||
tests/webtbs/uw18909b.pp svneol=native#text/pascal
|
||||
tests/webtbs/uw19159.pp svneol=native#text/pascal
|
||||
tests/webtbs/uw19697.pp svneol=native#text/pascal
|
||||
tests/webtbs/uw19701.pas svneol=native#text/plain
|
||||
tests/webtbs/uw19851.pp svneol=native#text/pascal
|
||||
tests/webtbs/uw2004.inc svneol=native#text/plain
|
||||
|
@ -4480,7 +4480,13 @@ implementation
|
||||
) and
|
||||
not(vo_is_funcret in tstaticvarsym(p).varoptions) and
|
||||
not(vo_is_external in tstaticvarsym(p).varoptions) and
|
||||
is_managed_type(tstaticvarsym(p).vardef) then
|
||||
is_managed_type(tstaticvarsym(p).vardef) and
|
||||
not (
|
||||
assigned(tstaticvarsym(p).fieldvarsym) and
|
||||
assigned(tstaticvarsym(p).fieldvarsym.owner.defowner) and
|
||||
(df_generic in tdef(tstaticvarsym(p).fieldvarsym.owner.defowner).defoptions)
|
||||
)
|
||||
then
|
||||
finalize_sym(TAsmList(arg),tsym(p));
|
||||
end;
|
||||
procsym :
|
||||
|
@ -43,7 +43,7 @@ type
|
||||
{$endif Test_Double_checksum}
|
||||
|
||||
const
|
||||
CurrentPPUVersion = 168;
|
||||
CurrentPPUVersion = 169;
|
||||
|
||||
{ buffer sizes }
|
||||
maxentrysize = 1024;
|
||||
|
@ -1270,7 +1270,7 @@ implementation
|
||||
include(fieldvs.symoptions,sp_static);
|
||||
{ generate the symbol which reserves the space }
|
||||
static_name:=lower(generate_nested_name(recst,'_'))+'_'+fieldvs.name;
|
||||
hstaticvs:=cstaticvarsym.create(internal_static_field_name(static_name),vs_value,fieldvs.vardef,[]);
|
||||
hstaticvs:=cstaticvarsym.create_from_fieldvar(static_name,fieldvs);
|
||||
{$ifdef jvm}
|
||||
{ for the JVM, static field accesses are name-based and
|
||||
hence we have to keep the original name of the field.
|
||||
|
@ -272,14 +272,21 @@ interface
|
||||
parameters as it is done by iso pascal with the program symbols,
|
||||
isoindex contains the parameter number }
|
||||
isoindex : dword;
|
||||
{ if this static variable was created based on a class field variable then this is set
|
||||
to the symbol of the corresponding class field }
|
||||
fieldvarsym : tfieldvarsym;
|
||||
fieldvarsymderef : tderef;
|
||||
constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);virtual;
|
||||
constructor create_dll(const n : string;vsp:tvarspez;def:tdef);virtual;
|
||||
constructor create_C(const n: string; const mangled : TSymStr;vsp:tvarspez;def:tdef);virtual;
|
||||
constructor create_from_fieldvar(const n:string;fieldvar:tfieldvarsym);virtual;
|
||||
constructor ppuload(ppufile:tcompilerppufile);
|
||||
destructor destroy;override;
|
||||
{ do not override this routine in platform-specific subclasses,
|
||||
override ppuwrite_platform instead }
|
||||
procedure ppuwrite(ppufile:tcompilerppufile);override;final;
|
||||
procedure buildderef;override;
|
||||
procedure deref;override;
|
||||
function mangledname:TSymStr;override;
|
||||
procedure set_mangledbasename(const s: TSymStr);
|
||||
function mangledbasename: TSymStr;
|
||||
@ -1813,6 +1820,13 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
constructor tstaticvarsym.create_from_fieldvar(const n: string;fieldvar:tfieldvarsym);
|
||||
begin
|
||||
create(internal_static_field_name(n),vs_value,fieldvar.vardef,[]);
|
||||
fieldvarsym:=fieldvar;
|
||||
end;
|
||||
|
||||
|
||||
constructor tstaticvarsym.ppuload(ppufile:tcompilerppufile);
|
||||
begin
|
||||
inherited ppuload(staticvarsym,ppufile);
|
||||
@ -1829,6 +1843,7 @@ implementation
|
||||
if vo_has_section in varoptions then
|
||||
section:=ppufile.getansistring;
|
||||
{$endif symansistr}
|
||||
ppufile.getderef(defaultconstsymderef);
|
||||
ppuload_platform(ppufile);
|
||||
end;
|
||||
|
||||
@ -1866,10 +1881,24 @@ implementation
|
||||
{$endif symansistr}
|
||||
if vo_has_section in varoptions then
|
||||
ppufile.putansistring(section);
|
||||
ppufile.putderef(fieldvarsymderef);
|
||||
writeentry(ppufile,ibstaticvarsym);
|
||||
end;
|
||||
|
||||
|
||||
procedure tstaticvarsym.buildderef;
|
||||
begin
|
||||
inherited buildderef;
|
||||
fieldvarsymderef.build(fieldvarsym);
|
||||
end;
|
||||
|
||||
|
||||
procedure tstaticvarsym.deref;
|
||||
begin
|
||||
inherited deref;
|
||||
fieldvarsym:=tfieldvarsym(fieldvarsymderef.resolve);
|
||||
end;
|
||||
|
||||
function tstaticvarsym.mangledname:TSymStr;
|
||||
var
|
||||
usename,
|
||||
|
16
tests/webtbs/tw19697.pp
Normal file
16
tests/webtbs/tw19697.pp
Normal file
@ -0,0 +1,16 @@
|
||||
{ %NORUN }
|
||||
|
||||
program tw19697;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
uw19697;
|
||||
|
||||
type
|
||||
TSpecialisedClass = specialize TGenericClass<Integer>;
|
||||
|
||||
begin
|
||||
TSpecialisedClass.Init;
|
||||
end.
|
||||
|
24
tests/webtbs/uw19697.pp
Normal file
24
tests/webtbs/uw19697.pp
Normal file
@ -0,0 +1,24 @@
|
||||
unit uw19697;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
generic TGenericClass<T> = class
|
||||
private
|
||||
class var
|
||||
FItems: array of T;
|
||||
public
|
||||
class procedure Init;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
class procedure TGenericClass.Init;
|
||||
begin
|
||||
SetLength(FItems, 1);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user