Outline freeing TFPList with disposing its items into TFPList.FreeAndNilDisposing.

compiler/cclasses.pas

@@ -116,6 +116,9 @@ type
 
     { FreeAndNil the list, and its items as TObjects. }
     class procedure FreeAndNilObjects(var Lst: TFPList); static;
+
+    { FreeAndNil the list, and dispose() its items. 'ItemType' is TypeInfo() of items. }
+    class procedure FreeAndNilDisposing(var Lst: TFPList; ItemType: Pointer); static;
   end;
 
 
@@ -1058,6 +1061,26 @@ begin
   Lst := nil;
 end;
 
+procedure fpc_finalize(data, typeinfo: pointer); external;
+
+class procedure TFPList.FreeAndNilDisposing(var Lst: TFPList; ItemType: Pointer);
+var
+  Lp: PPointer;
+  I: SizeInt;
+begin
+  if not Assigned(Lst) then
+    exit;
+  Lp := Lst.FList;
+  for I := 0 to Lst.Count-1 do
+    if Assigned(Lp[I]) then
+      begin
+        fpc_finalize(Lp[I],ItemType);
+        FreeMem(Lp[I]);
+      end;
+  Lst.Free;
+  Lst := nil;
+end;
+
 
 {*****************************************************************************
             TFPObjectList (Copied from rtl/objpas/classes/lists.inc)

compiler/globals.pas

@@ -1639,15 +1639,6 @@ implementation
      initdoneprocs : TFPList = nil;
 
 
-   procedure allocinitdoneprocs;
-     begin
-       { Avoid double initialization }
-       if assigned(initdoneprocs) then
-         exit;
-       initdoneprocs:=tfplist.create;
-     end;
-
-
    procedure register_initdone_proc(init,done:tprocedure);
      var
        entry : pinitdoneentry;
@@ -1655,14 +1646,7 @@ implementation
        new(entry);
        entry^.init:=init;
        entry^.done:=done;
-       { Do not rely on the fact that
-         globals unit initialization code
-         has already been executed.
-         Unit initialization order is too
-         uncertian for that. PM }
-       if not assigned(initdoneprocs) then
-         allocinitdoneprocs;
-       initdoneprocs.add(entry);
+       TFPList.AddOnDemand(initdoneprocs,entry);
      end;
 
 
@@ -1692,20 +1676,6 @@ implementation
      end;
 
 
-   procedure freeinitdoneprocs;
-     var
-       i : longint;
-     begin
-       if not assigned(initdoneprocs) then
-         exit;
-       for i:=0 to initdoneprocs.count-1 do
-         dispose(pinitdoneentry(initdoneprocs[i]));
-       initdoneprocs.free;
-       { Reset variable, to be on the safe side }
-       initdoneprocs:=nil;
-     end;
-
-
    procedure DoneGlobals;
      begin
        calldoneprocs;
@@ -1810,12 +1780,11 @@ implementation
      end;
 
 initialization
-  allocinitdoneprocs;
 {$ifdef LLVM}
   cgbackend:=cg_llvm;
 {$else}
   cgbackend:=cg_fpc;
 {$endif}
 finalization
-  freeinitdoneprocs;
+  tfplist.FreeAndNilDisposing(initdoneprocs,TypeInfo(tinitdoneentry));
 end.

compiler/pgentype.pas

@@ -65,13 +65,9 @@ begin
 end;
 
 destructor tspecializationcontext.destroy;
-var
-  i : longint;
 begin
   paramlist.free;
-  for i:=0 to poslist.count-1 do
-    dispose(pfileposinfo(poslist[i]));
-  poslist.free;
+  tfplist.FreeAndNilDisposing(poslist,TypeInfo(tfileposinfo));
   inherited destroy;
 end;
 

compiler/psub.pas

@@ -684,15 +684,8 @@ implementation
 ****************************************************************************}
 
      destructor tcgprocinfo.destroy;
-       var
-         i : longint;
        begin
-         if assigned(tempinfo_flags_map) then
-           begin
-             for i:=0 to tempinfo_flags_map.count-1 do
-               dispose(ptempinfo_flags_entry(tempinfo_flags_map[i]));
-             tempinfo_flags_map.free;
-           end;
+         TFPList.FreeAndNilDisposing(tempinfo_flags_map,TypeInfo(ttempinfo_flags_entry));
          code.free;
          inherited destroy;
        end;

compiler/symdef.pas

@@ -8024,8 +8024,6 @@ implementation
 
 
     destructor tobjectdef.destroy;
-      var
-        i: longint;
       begin
          if assigned(symtable) then
            begin
@@ -8044,13 +8042,7 @@ implementation
              dispose(iidguid);
              iidguid:=nil;
            end;
-         if assigned(vmtentries) then
-           begin
-             for i:=0 to vmtentries.count-1 do
-               dispose(pvmtentry(vmtentries[i]));
-             vmtentries.free;
-             vmtentries:=nil;
-           end;
+         TFPList.FreeAndNilDisposing(vmtentries,TypeInfo(tvmtentry));
          if assigned(vmcallstaticinfo) then
            begin
              freemem(vmcallstaticinfo);

compiler/symtable.pas

@@ -1211,29 +1211,8 @@ implementation
 
 
     destructor tabstractrecordsymtable.destroy;
-
-      { for some reason a compiler built with 3.3.1 fails building the libxml2
-        package if the below define is not defined and thus the code snippet is
-        part of the destructor itself and not a nested procedure; until that bug
-        is fixed this is used as a workaround :/ }
-{$define codegen_workaround}
-{$ifdef codegen_workaround}
-      procedure free_mop_list(mop:tmanagementoperator);
-        var
-          i : longint;
-        begin
-          if assigned(mop_list[mop]) then
-            for i:=0 to mop_list[mop].count-1 do
-              dispose(pmanagementoperator_offset_entry(mop_list[mop][i]));
-          mop_list[mop].free;
-        end;
-{$endif codegen_workaround}
-
       var
         mop : tmanagementoperator;
-{$ifndef codegen_workaround}
-        i : longint;
-{$endif codegen_workaround}
       begin
         if refcount>1 then
           exit;
@@ -1241,16 +1220,7 @@ implementation
         fllvmst.free;
 {$endif llvm}
         for mop:=low(tmanagementoperator) to high(tmanagementoperator) do
-          begin
-{$ifdef codegen_workaround}
-            free_mop_list(mop);
-{$else codegen_workaround}
-            if assigned(mop_list[mop]) then
-              for i:=0 to mop_list[mop].count-1 do
-                dispose(pmanagementoperator_offset_entry(mop_list[mop][i]));
-            mop_list[mop].free;
-{$endif codegen_workaround}
-          end;
+          TFPList.FreeAndNilDisposing(mop_list[mop],TypeInfo(tmanagementoperator_offset_entry));
         inherited destroy;
       end;