Browse Source

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

Sven/Sarah Barth 10 months ago
parent
commit
73420dcace
4 changed files with 73 additions and 4 deletions
  1. 9 2
      compiler/ngenutil.pas
  2. 10 2
      compiler/ninl.pas
  3. 41 0
      tests/tbs/tb0717.pp
  4. 13 0
      tests/tbs/ub0717.pp

+ 9 - 2
compiler/ngenutil.pas

@@ -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;

+ 10 - 2
compiler/ninl.pas

@@ -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 - 0
tests/tbs/tb0717.pp

@@ -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 - 0
tests/tbs/ub0717.pp

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