* ensure that Default() symbols that use management operators are properly initalized/finalized

+ added test
This commit is contained in:
Sven/Sarah Barth 2024-10-11 18:00:01 +02:00
parent cc063e7a9c
commit 73420dcace
4 changed files with 73 additions and 4 deletions

View File

@ -359,7 +359,10 @@ implementation
) and
not(vo_is_typed_const in tabstractvarsym(p).varoptions) and
not(vo_is_external in tabstractvarsym(p).varoptions) and
not(vo_is_default_var in tabstractvarsym(p).varoptions) and
(
not (vo_is_default_var in tabstractvarsym(p).varoptions) or
(tabstractvarsym(p).varspez<>vs_const)
) and
(is_managed_type(tabstractvarsym(p).vardef) or
((m_iso in current_settings.modeswitches) and (tabstractvarsym(p).vardef.typ=filedef))
) then
@ -376,9 +379,13 @@ implementation
begin
if (tsym(p).typ=localvarsym) and
(tlocalvarsym(p).refs>0) and
not(vo_is_typed_const in tlocalvarsym(p).varoptions) and
not(vo_is_external in tlocalvarsym(p).varoptions) and
not(vo_is_funcret in tlocalvarsym(p).varoptions) and
not(vo_is_default_var in tabstractvarsym(p).varoptions) and
(
not(vo_is_default_var in tabstractvarsym(p).varoptions) or
(tabstractvarsym(p).varspez<>vs_const)
) and
is_managed_type(tlocalvarsym(p).vardef) then
sym_maybe_finalize(tstatementnode(arg^),tsym(p));
end;

View File

@ -475,6 +475,7 @@ implementation
srsym : tsym;
srsymtable : tsymtable;
defaultname : tidstring;
varspez : tvarspez;
begin
if not assigned(def) or
not (def.typ in [arraydef,recorddef,variantdef,objectdef,procvardef]) or
@ -502,10 +503,17 @@ implementation
srsym:=tsym(srsymtable.findwithhash(hashedid));
if not assigned(srsym) then
begin
varspez:=vs_const;
{ if we have an initialize or finalize management operator then
we may not declare this as const as the unit init-/finalization
needs to be able to modify it }
if (def.typ=recorddef) and (mop_initialize in trecordsymtable(trecorddef(def).symtable).managementoperators) then
varspez:=vs_var;
{ no valid default variable found, so create it }
srsym:=cstaticvarsym.create(defaultname,vs_const,def,[]);
srsym:=cstaticvarsym.create(defaultname,varspez,def,[]);
{ mark the staticvarsym as typedconst }
include(tabstractvarsym(srsym).varoptions,vo_is_typed_const);
if varspez=vs_const then
include(tabstractvarsym(srsym).varoptions,vo_is_typed_const);
include(tabstractvarsym(srsym).varoptions,vo_is_default_var);
{ The variable has a value assigned }
tabstractvarsym(srsym).varstate:=vs_initialised;

41
tests/tbs/tb0717.pp Normal file
View File

@ -0,0 +1,41 @@
program tb0717;
{$mode objfpc}
{$modeswitch advancedrecords}
uses
ub0717;
type
TTest = record
i: LongInt;
class operator Initialize(var t: TTest);
class operator Finalize(var t: TTest);
end;
class operator TTest.Initialize(var t: TTest);
begin
t.i := 42;
end;
class operator TTest.Finalize(var t: TTest);
begin
{ if this isn't reached then the finalization section of ub0717 will exit
with an error }
TestOk := True;
end;
procedure Test;
var
t: TTest;
begin
if t.i <> 42 then
Halt(1);
t := Default(TTest);
if t.i <> 42 then
Halt(2);
end;
begin
Test;
end.

13
tests/tbs/ub0717.pp Normal file
View File

@ -0,0 +1,13 @@
unit ub0717;
interface
var
TestOk: Boolean = False;
implementation
finalization
if not TestOk and (ExitCode = 0) then
ExitCode := 3;
end.