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

[-TarasBer-]

А, ну то есть ровно то, что я и сказал, судя по картинке.
Для тех переменных, для которых можно предсказать (для всех, упоминаемых во всех вложенных блоках данной процедуры), выделяем место как обычно, для тех, для которых нельзя, выделяем указатель как обычно, а их самих выделяем на вершине стека.
Это хорошо, что там не дёргается куча, всё собирается простыми алгоритмами прямо на стеке.

[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 ов - паскалевская идея с переменной, куда пишется результат, мне нравится больше, потому что сразу всё пишется в результат, без лишнего копирования.

[volvo]

Во-первых, не надо делать лишних вещей, Ада позволяет гораздо более красивую реализацию функции:

   function To_CStr (S: String) return CStr is
   begin
      return CStr'(Ada.Finalization.Controlled with r => new String'(S));
   end;

, а во-вторых, не все то, что Debug_Pool показывает как утечку, на самом деле является таковой, в некоторых случаях этот метод дает осечки. valgrind не нашел утечки (с новой функцией), хотя Debug_Pool по прежнему пишет то же самое...

Можешь почитать вот это, кстати:
Куда девалась память (часть 1)
Куда девалась память (часть 2)
Куда девалась память (часть 3)


Добавлено через 18 мин.

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

То есть, Extended return, как я понимаю, тоже прошел мимо тебя?

Добавлено через 18 мин.

А на самом деле я хочу, чтобы можно было писать хотя бы так:
CreateWindow(..., TO_WIDE(ClassName).s, TO_WIDE(Title).s, ....)

Я обычно делал так:

Ну, скажем, надо создать кнопку с кириллицей... (Показать/Скрыть)

В отдельном файле создавались все текстовые константы, файл сохранялся в формате UTF-8 стандартным виндовым блокнотом, и не редактировался редактором из GPS, отображать этот файл среда под Windows умеет, а вот сохранять его - нет, сбивается кодировка. Поэтому редактировались эти константы только родными виндовыми средствами, либо теми, кто точно кодировку не рушит. Я пользовался когда NotePad-ом, а когда SciTE, по настроению. Вот так описываются константы:
txtconst.ads

with Interfaces.C;

package TxtConst is
   use type Interfaces.C.wchar_array;

   BtnLoad_Text : Interfaces.C.wchar_array := "Открыть" & Interfaces.C.wide_nul;
   BtnSave_Text : Interfaces.C.wchar_array := "Сохранить" & Interfaces.C.wide_nul;
   BtnClear_Text : Interfaces.C.wchar_array := "Очистить" & Interfaces.C.wide_nul;

   --  ...

end TxtConst;

, писалась функция создающая нужный контрол:

   --  К примеру, функция, создающая кнопочку:
   function Create_Button (Instance : Win32.Windef.HINSTANCE;
                           Pos_X, Pos_Y : Win32.INT;
                           Width, Height : Win32.INT;
                           Caption : Interfaces.C.wchar_array;
                           Parent : Win32.Windef.HWND;
                           Button_ID : Integer;
                           Font : Win32.Windef.HFONT := Common_Font)
                           return Win32.Windef.HWND is
      Res_Handle : Win32.Windef.HWND;
      L_Result : Win32.LRESULT;
      pragma Unreferenced (L_Result);

      use Win32.Winuser;
      Style : constant Win32.DWORD :=
        WS_CHILD or WS_VISIBLE or BS_PUSHBUTTON;
   begin
      Res_Handle :=
        CreateWindowExW (dwExStyle => 0,
                         lpClassName => Class_Ws,
                         lpWindowName => Empty_Ws,
                         dwStyle => Style,
                         X => Pos_X,
                         Y => Pos_Y,
                         nWidth => Width,
                         nHeight => Height,
                         hWndParent => Parent,
                         hMenu => Conversions.To_HMENU (Button_ID),
                         hInstance => Instance,
                         lpParam => System.Null_Address);

      if Font /= System.Null_Address then
         L_Result := SendMessage (Res_Handle, WM_SETFONT,
                                  Conversions.To_WPARAM (Font), 0);
      end if;
      L_Result := SendMessageW (hWnd   => Res_Handle,
                                Msg    => WM_SETTEXT,
                                wParam => 0,
                                lParam => Conversions.To_LPARAM
                                  (Caption'Address));
      return Res_Handle;
   end Create_Button;

, и вызывалось все это вот таким образом:

      Btn_Load := WinLib.Create_Button (Instance  => hInst,
                                        Pos_X     => 16,
                                        Pos_Y     => 630,
                                        Width     => 75,
                                        Height    => 27,
                                        Caption   => BtnLoad_Text,
                                        Parent    => Win_Hwnd,
                                        Button_ID => Wndproc.BTN_LOAD);

Сообщение отредактировано: volvo - 22.02.2011 16:58

[TarasBer]

> Куда девалась память (часть 1)
> Куда девалась память (часть 2)
> Куда девалась память (часть 3)
> Extended return

Пока не открывается, потом посмотрю.
(да, мимо меня много чего прошло пока).

> В отдельном файле создавались все текстовые константы, файл сохранялся в формате UTF-8 стандартным виндовым блокнотом, и не редактировался редактором из GPS, отображать этот файл среда под Windows умеет, а вот сохранять его - нет, сбивается кодировка.

А они это исправлять будут? И кодировку, и то, что под виндой переносы строк надо записывать как #13#10, а не просто #13?

[volvo]

А они это исправлять будут?

Я сомневаюсь, что это вообще исправимо. Где-то на AdaCore видел много вопросов "что за дела с кодировкой?", и на них отвечали разработчики среды. Пока не получается поправить (тем более что подавляющее большинство разработок на Аде ведется под никсами), там мало того, что в качестве прослойки Python воткнули, который тоже свою долю в коверкание кодировок вносит, так еще в винде с кодировками вообще - гораздо хуже, чем в никсах. Кстати, это проблема не только GPS, у меня и в QT Designer-е такая же фигня происходит: вроде заявляли полную поддержку Юникода, но как только я пишу что-то на форму - все прекрасно, как дело касается инициализации строки в исходнике - получаю кракозябры, хотя все в UTF-8.

В Дебиане нет проблем ни там ни там почему-то.

[TarasBer]

> тем более что подавляющее большинство разработок на Аде ведется под никсами

Это всё объясняет...

sites.google.com у меня не открывается, я погуглил по фразам из твоей подписи, попал сюда:
http://vlady.uzelok.net/smf/index.php?board=24.0

Всё тут есть?

[volvo]

Всё тут есть?

Да, пока я оставил и там и там, сервисы Гугла были какое-то время недоступны, пришлось продублировать...

[TarasBer]

Расширенный возврат - мощная вещь, только зачем надо обязательно указывать тип?

function GetI: integer is begin
   return i do // ошибка компиляции
      i := 3;
   end return;
end;

[volvo]

Потому что не всегда можно обойтись без описания типа. Как вариант:

function St return String is
begin
   return Value do
      -- Какого размера должна быть строка Value? Как ее заполнить?
   end return;
end St;

Также с 'Class-типами могут начаться проблемы, если не указывать явно тип в расширенном return-е.

[TarasBer]

> return Value do

Ну например return Value(1 .. 5) do

> Также с 'Class-типами могут начаться проблемы, если не указывать явно тип в расширенном return-е.

Тогда понятно.

> В отдельном файле создавались все текстовые константы, файл сохранялся в формате UTF-8 стандартным виндовым блокнотом,

Как раз тогда лучше в ANSI из блокнота сохранить, чтобы воспринимать русское 'а' как один символ.
Ещё можно в редакторе выставить кодировку, в которой русские символы занимают 1 байт. Но там есть только KOI-8 и ISO-8859-5, ANSI нету.
Кстати, какие параметры надо прописать в MultiByteToWideChar, чтобы она работала с KOI-8 или ISO-8859-5?

А, всё оказалось проще. Я работаю с УТФ-8, но для всех процедур принимаю именно просто-строку (не юникод), которую для юникодных компонентов переделываю через MultiByteToWideChar с константой CP_UTF8 : constant WORD := 65001, скопированной из System.Win32. Кстати, почему этот модуль нельзя подключать, в нём же много полезного?

Сообщение отредактировано: TarasBer - 24.02.2011 17:03

[volvo]

Как раз тогда лучше в ANSI из блокнота сохранить, чтобы воспринимать русское 'а' как один символ.

У меня системная кодировка = Hebrew (win 1255), не будет сохранено 'а' одним символом, сохранится 'HEBREW LETTER ALEF'. Именно поэтому я говорю всем, кто начинает писать юникодные программы: "пишите их на машине, где системная кодировка либо вообще нейтральная (английская), либо какая-нибудь экзотическая, не совпадающая с той, которая (как вам кажется) должна стоять у всех. Это вам только кажется, системную кодировку каждый волен выбирать по своему вкусу и по своим потребностям, а не по потребностям вашей программы. Будете писать при non-unicode = Cyrillic - пользователи будут огребать проблемы, источников которых вы не поймете, ибо у вас будет работать, у других - зависит от положения Луны на небе. Повезет - сработает, нет - не сработает"

А, всё оказалось проще. Я работаю с УТФ-8, но для всех процедур принимаю именно просто-строку (не юникод), которую для юникодных компонентов переделываю через MultiByteToWideChar с константой CP_UTF8 : constant WORD := 65001, скопированной из System.Win32

Это будет работать ровно до тех пор, пока ты не перекомпилируешь свою программу на машине с некириллической системной страницей (Китай, Индия, Япония, все азиатские страны, ну, и Израиль в том числе, практически гарантированно пролетают, потенциально - любая машина, на которой non-unicode не выставлен в Cyrillic. Я на такой риск пойти не могу, наши программы работают не только на одной машине, и пересобираются тоже в разных странах, так что вся работа делается через юникодные файлы). Вот тогда ты поймешь, что значит бардак с кодировками...

[TarasBer]

> Это будет работать ровно до тех пор, пока ты не перекомпилируешь свою программу на машине с некириллической системной страницей

Русские утф-8 символы останутся же русскими утф-8 символами? И функция перекодировки останется та же с теми же параметрами. Что изменится?

[volvo]

для всех процедур принимаю именно просто-строку (не юникод)

Ты можешь гарантировать, что "просто строка" не будет на той реализации, где программа перекомпилируется, зависеть от системной кодировки, и что компилятором не будет предприниматься никаких автоматических действий с НЕюникодной строкой? Вот по отношению к юникоду я уверен в этом: никаких перекодировок не будет. Как только дело касается не Wide_String/Wide_Wide_String, а просто String - уверенным ни в чем быть нельзя. Стандарт не гарантирует...

[TarasBer]

Я уверен только в том, что на другой машине, где стоит ГНАТ, настроенный на УТФ-8, будет перекомпилировываться корректно. Я ведь могу быть в этом уверен?
Вариант не лучший, но ждать, когда в ГНАТ добавят нормальный АНСИ или исправят баг?

[TarasBer]

Решил я применить расширенный возврат к функции преобразования массива в вектор (кстати, почему её нет стандартной?), ну, чтобы не копировать лишнее.

function To_Vector(a: Key_Arr) return Key_Based_Vectors.Vector is

      Arr_Index: Integer := a'First;

      procedure Update(Item: in out Key_Base) is
      begin
         Item := A(Arr_Index);
         Arr_Index := Arr_Index + 1;
      end Update;

      procedure Copy(C: Key_Based_Vectors.Cursor) is
      
         type Public_Cursor is record
            Container : access Key_Based_Vectors.Vector;
            Index     : integer;
         end record;
      
         function Fuck_Cursor is new Ada.Unchecked_Conversion(Key_Based_Vectors.Cursor, Public_Cursor);
      
      begin      
         -- где логика в стандартном контейнере?
         -- нафига этой процедуре принимать контейнер, если она и так принимает курсор?
         -- где стандартная функция преобразования массива в вектор?
         -- где стандартная обратная функция?
         Update_Element (Fuck_Cursor©.Container.all, C, Update'Access);
      end Copy;

      use Key_Based_Vectors;

   begin
      return V: Key_Based_Vectors.Vector do   
         Set_Length(V, A'Length);
         V.Iterate (Copy'Access);
      end return;
   end To_Vector;

Не, не скомпилилось.

parser.adb:31:10: no candidate interpretations match the actuals:
parser.adb:31:51: expected private type "Ada.Containers.Vectors.Vector" from instance at parser.ads:28
parser.adb:31:51: found private type "Ada.Containers.Vectors.Vector" from instance at parser.ads:29
parser.adb:31:51: ==> in call to "Update_Element" at a-convec.ads:134, instance at parser.ads:28
parser.adb:31:51: ==> in call to "Update_Element" at a-convec.ads:129, instance at parser.ads:28

Это не вектор, это вектор, а не вектор, а нужен именно вектор.

Зато я только сейчас заметил, что в Аде можно в итераторы кидать локальные подпрограммы, в Дельфи приходилось в глобальную область всякую фигню выводить. Там типа неявно стек копируется?

[volvo]

Внимательнее будь. Это основа успеха при освоении Ады. Смотри:

use Func_Tree_Vectors;  --  Это у тебя было, правда?

function To_Vector(a: Key_Arr) return Key_Based_Vectors.Vector is

      Arr_Index: Integer := a'First;

      procedure Update(Item: in out Key_Base) is
      begin
         Item := A(Arr_Index);
         Arr_Index := Arr_Index + 1;
      end Update;
      
      use Key_Based_Vectors;  --  Вот эта строка была на несколько строк ниже ...

      procedure Copy(C: Key_Based_Vectors.Cursor) is
      
         type Public_Cursor is record
            Container : access Key_Based_Vectors.Vector;
            Index     : integer;
         end record;
      
         function Fuck_Cursor is new Ada.Unchecked_Conversion(Key_Based_Vectors.Cursor, Public_Cursor);
      
      begin      
         Update_Element (Fuck_Cursor ( C ).Container.all, C, Update'Access);
      end Copy;

   begin
      return V: Key_Based_Vectors.Vector do   
         Set_Length(V, A'Length);
         V.Iterate (Copy'Access);
      end return;
   end To_Vector;

, и уже все компилируется. Почему надо было переносить use выше, понятно? Если бы она была там, где ее написал ты, то доступен только один Update_Element: из пакета Func_Tree_Vectors, чей use присутствует выше по тексту. А эта функция должна принимать другой тип контейнера, о чем Ада тебе пыталась сказать. Номера строк, в которых инстанцирован "Ada.Containers.Vectors.Vector" не просто так даются, можно было посмотреть, что происходит в этих строках...

Как только use перенесен выше по тексту, уже доступна и вторая процедура Update_Element, из Key_Based_Vectors. Тут уже компилятор способен по параметрам разобраться, какую из перегруженных версий вызывать...

[TarasBer]

И всё-таки, как это сделать без непроверенной конверсии с идеологически неверным кулхацкеровским "раздеванием" курсора?
Если унаследовать свой вектор от этого, то я получу доступ к его приватным полям и возможность написать преобразование нормально?

Сообщение отредактировано: TarasBer - 14.03.2011 18:20

[volvo]

И всё-таки, как это сделать без непроверенной конверсии с идеологически неверным кулхацкеровским "раздеванием" курсора?

Да легко:

function To_Vector(a: Key_Arr) return Key_Based_Vectors.Vector is

   Arr_Index: Integer := a'First;

   procedure Update(Item: in out Key_Base) is
   begin
      Item := A(Arr_Index);
      Arr_Index := Arr_Index + 1;
   end Update;
      
   use Key_Based_Vectors;
   begin
      return V: Key_Based_Vectors.Vector do

         declare

	    procedure My_Copy(C: Key_Based_Vectors.Cursor) is
	    begin
	       V.Update_Element (C, Update'Access);
	    end My_Copy;

	 begin
            Set_Length(V, A'Length);
	    V.Iterate (My_Copy'Access);
	 end;

      end return;
   end To_Vector;

Где "раздевание" курсора? Где конверсии? Нету... Однако, компилируется без проблем. Но вот контейнер должен быть описан выше по коду, чем процедура обработки. А к вопросу

нафига этой процедуре принимать контейнер, если она и так принимает курсор?

ответ - такой: Чтоб без подобных выкрутасов, как ты сделал (с непроверенными конверсиями и другими кулхацкерскими штучками) не позволить тебе изменить с помощью Update_Element константный контейнер (было бы слишком просто: получил Курсор, передал его в Update_Element, и все, прощай константность вектора? Нет уж, лучше так, как сейчас...). Безопасность превыше всего. Кстати, изначально в А2005 была-таки версия Update_Element, которая принимала всего 2 параметра: Курсор и Процесс. Но это была дыра в безопасности, и ее очень быстро закрыли...

[TarasBer]

Это уже получше.
И ещё вопрос: как унаследоваться от стандартного вектора так, чтобы сохранить все операции над ним?

type Vector is new Vectors.Vector with record
null;
end record;

type Cursor is new Vectors.Cursor;

Позволяет работать с операциями над чисто контейнером, но не позволяет работать с операциями, в которых участвует курсор.

Сообщение отредактировано: TarasBer - 14.03.2011 19:33

[volvo]

Непонятно, зачем наследоваться от отдельного типа, если можно сразу получить весь функционал пакета? На кой наследование-то? Как хочешь его использовать потом? Что инстанцировать собрался? Всё, что описано в Ada.Containers.Vector - оно дженериковое вообще-то, в любом случае надо где-то говорить, с какими типами это все будет работать. Так зачем делать несколько разрозненных типов, если можно настроить весь пакет, и его полноценно использовать?

P.S.

type Vector is new Vectors.Vector with record
null;
end record;

- это устаревшая запись. Уже давно можно делать

type Descendant is new Base with null record;