mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-30 15:20:35 +02:00
* ensure that Default() symbols that use management operators are properly initalized/finalized
+ added test
This commit is contained in:
parent
cc063e7a9c
commit
73420dcace
@ -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;
|
||||
|
@ -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
41
tests/tbs/tb0717.pp
Normal 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
13
tests/tbs/ub0717.pp
Normal file
@ -0,0 +1,13 @@
|
||||
unit ub0717;
|
||||
|
||||
interface
|
||||
|
||||
var
|
||||
TestOk: Boolean = False;
|
||||
|
||||
implementation
|
||||
|
||||
finalization
|
||||
if not TestOk and (ExitCode = 0) then
|
||||
ExitCode := 3;
|
||||
end.
|
Loading…
Reference in New Issue
Block a user