Отлов утечек памяти - GNAT, (разделено) Опции

[TarasBer]

Новые вопросы - какая функция определяет наличие или отсутствие утечек памяти?
Я скачал ВинАДУ, поставил, как подключить пакет, содержащий заголовки виндовых библиотек? with ADA.Windows не рабтает, нет такого пакета.

[TarasBer]

Ещё вопрос.
Контролируемые объекты, созданные, как промежуточный результат вычислений, удаляются уже после вычислений же?

procedure Test is

   type aString is access all String;
   type aChar is access all Character;
   
   for aString'Storage_Pool use Debug_Options.D_Pool;

   type cStr is new Ada.Finalization.Controlled with record
      r: aString;
   end record;

   procedure Initialize(a: in out cStr);
   procedure Finalize(a: in out cStr);

   procedure Initialize(a: in out cStr) is
   begin
      a.r := null;
   end;

   procedure Finalize(a: in out cStr) is
      procedure Free is new ADA.Unchecked_Deallocation(String, aString);
   begin
      if a.r /= null then
         Free(a.r);
      end if;
   end;
--------------------------------------------------------------------------------
   function To_CStr (S: String) return cStr is
      result: cStr;
   begin
      result.r := new String(1 .. S'Length);
      result.r.all := S;
      return result;
   end;

begin
   #if Test_Leaks
   GNAT.Debug_Pools.Configure (D_Pool, Raise_Exceptions => False);
   #end if;

   Put_Line(To_CStr("TEST").r.all);

   #if Test_Leaks
   GNAT.Debug_Pools.Print_Info_Stdout (D_Pool, Display_Leaks => True);
   #end if;
end Test;

Выдаёт

C:\Program\ Files\ADA\projects\test\test
error: Accessing deallocated storage, at 0x6A3079AF 0x6A2CBF61 0x6A2CDC15 0x0041A416 0x0040178C 0x004010B4 0x00401146 0x7C817065 
  First deallocation at 0x6A3079AF 0x6A2CC522 0x6A2CE042 0x0041ABB2 0x6A31EEB8 0x0041AB0B 0x0041AA9B 0x0041A262 0x0040178C 0x004010B4 0x00401146 0x7C817065 
  Initial allocation at 0x6A3079AF 0x6A2CC522 0x6A2CEB62 0x0041A78E 0x0041A262 0x0040178C 0x004010B4 0x00401146 0x7C817065 
TEST
error: Freeing already deallocated storage, at 0x6A3079AF 0x6A2CBF61 0x6A2CE4EB 0x0041ABB2 0x6A31EEB8 0x0041A53E 0x0041A44E 0x0040178C 0x004010B4 0x00401146 0x7C817065 
   Memory already deallocated at 0x6A3079AF 0x6A2CC522 0x6A2CE042 0x0041ABB2 0x6A31EEB8 0x0041AB0B 0x0041AA9B 0x0041A262 0x0040178C 0x004010B4 0x00401146 0x7C817065 
   Memory was allocated at 0x6A3079AF 0x6A2CC522 0x6A2CEB62 0x0041A78E 0x0041A262 0x0040178C 0x004010B4 0x00401146 0x7C817065 
Total allocated bytes :  12
Total logically deallocated bytes :  12
Total physically deallocated bytes :  0
Current Water Mark:  0
High Water Mark:  12


List of not deallocated blocks:
[2011-02-22 11:15:27] process terminated successfully (elapsed time: 00.18s)

Видимо проблема в том, что return объект делает finalize и adjust. (зачем?)


Кстати, как сделать, чтобы инициализация отладчика не перекидывала меня с той страницы, что я смотрю?


Добавлено через 13 мин.
Попытка следующая. Чтобы не копировать строку лишний раз, лепим счётчик ссылок.

procedure Test is

   type Cnt_Str(i: integer) is record
      rc: integer;
      s: string(1 .. i);
   end record;

   type aCnt_Str is access all Cnt_Str;
   type aChar is access all Character;

   for aCnt_Str'Storage_Pool use Debug_Options.D_Pool;

   type cStr is new Ada.Finalization.Controlled with record
      r: aCnt_Str;
   end record;

   procedure Initialize(a: in out cStr);
   procedure Finalize(a: in out cStr);
   procedure Adjust(a: in out cStr);

   procedure Initialize(a: in out cStr) is
   begin
      a.r := null;
   end;

   procedure Finalize(a: in out cStr) is
      procedure Free is new ADA.Unchecked_Deallocation(Cnt_Str, aCnt_Str);
   begin
      if (a.r /= null) then
         a.r.rc := a.r.rc - 1;
         if a.r.rc = 0 then
            Free(a.r);
         end if;
      end if;
   end;

   procedure Adjust(a: in out cStr) is
   begin
      a.r.rc := a.r.rc + 1;
   end;
--------------------------------------------------------------------------------
   function To_CStr (S: String) return cStr is
      result: cStr;
   begin
      result.r := new Cnt_Str(S'Length);
      result.r.rc := 1;
      result.r.s := S;
      return result;
   end;

begin
   #if Test_Leaks
   GNAT.Debug_Pools.Configure (D_Pool, Raise_Exceptions => False);
   #end if;

   Put_Line(To_CStr("TEST").r.s);

   #if Test_Leaks
   GNAT.Debug_Pools.Print_Info_Stdout (D_Pool, Display_Leaks => True);
   #end if;
end Test;

Программа вылетает на
result.r := new Cnt_Str(S'Length);

Добавлено через 9 мин.
А на самом деле я хочу, чтобы можно было писать хотя бы так:

CreateWindow(..., TO_WIDE(ClassName).s, TO_WIDE(Title).s, ....)

(т.е. TO_WIDE создаёт объект,внутри которого есть как и ссылка на строку с добавленным нулём, там и ссылка на первый символ этой строки (поле s), и чтобы не надо было руками этот объект удалять).

Ещё проблема: когда у меня это работало, русские символы превращались в две закорючки.

А по поводу return ов - паскалевская идея с переменной, куда пишется результат, мне нравится больше, потому что сразу всё пишется в результат, без лишнего копирования.