Конференция "Начинающим" » Куда уходит память? [D7]
 
  • fics © (13.04.17 19:56) [0]

    unit Unit1;

    interface

    uses
     Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
     Dialogs, StdCtrls;

    type
     TForm1 = class(TForm)
       Button1: TButton;
       procedure Button1Click(Sender: TObject);
       procedure FormCreate(Sender: TObject);
     private
       { Private declarations }
     public
       { Public declarations }
     end;

    var
     Form1: TForm1;
     StringList: TStringList;

    implementation

    {$R *.dfm}

    procedure TForm1.Button1Click(Sender: TObject);
    var
     i: Integer;
     S: String;
    begin
     S := StringList.Text;
     i := 1;
     while i < Length(S) do begin
       Inc(i);
       S := '!';
       Application.ProcessMessages;
     end;
    end;

    procedure TForm1.FormCreate(Sender: TObject);
    begin
     StringList := TStringList.Create;
     StringList.LoadFromFile('1.txt');
    end;

    end.



    Достаточно загрузить в StringList 10-20Mb файл покликать по кнопке и вскоре получим Out of Memory. Вопрос задаю не из интереса. В одном из моих проектов есть подобная ошибка, если ее можно так назвать, а примерчик просто для иллюстрации механизма
  • Dimka Maslov © (13.04.17 20:16) [1]
    А кто и где будет делать StringList.Free?
  • Игорь Шевченко © (13.04.17 20:57) [2]
    Ситуация не воспроизводится, память не утекает, кроме выделенной под StringList и потроха файла.
  • fics © (13.04.17 21:01) [3]

    > Игорь Шевченко ©   (13.04.17 20:57) [2]
    >
    > Ситуация не воспроизводится, память не утекает, кроме выделенной
    > под StringList и потроха файла.

    Ошибся от руки написал

    while i < Length(S) do begin
      Inc(i);
      S := '!'; S[i] := '!'; //или вообще можно закоментировать дабы не обнулять S;  
      Application.ProcessMessages;
    end;
  • fics © (13.04.17 21:20) [4]
    так не бегит:

    var
     Form1: TForm1;
     StringList: TStringList;
     S: String;

    implementation

    {$R *.dfm}

    procedure TForm1.Button1Click(Sender: TObject);
    var
     i: Integer;
    begin
     i := 1;
     while i < Length(S) do begin
       Inc(i);
       Application.ProcessMessages;
     end;
    end;

    procedure TForm1.FormCreate(Sender: TObject);
    begin
     StringList := TStringList.Create;
     StringList.LoadFromFile('1.txt');
     S := StringList.Text;
    end;


    Но это нужно делать S глобальной, и не делать  S := StringList.Text; внутри Button1Click, что не удовлетворяет нужным требованиям
  • fics © (13.04.17 21:31) [5]

    > Но это нужно делать S глобальной, и не делать  S := StringList.
    > Text; внутри Button1Click, что не удовлетворяет нужным требованиям

    S нужно по каждому новому запросу (в данном случае по клику) обновлять из S := StringList.Text;
  • DVM © (13.04.17 22:06) [6]
    В этом коде нет утечек.
    Вставлять Application.processmessages в каждую итерацию цикла как то не очень.
    Не лучше ли оформить все в доп потоке?
    Что этот код вообще делать должен. Он странный.
  • Игорь Шевченко © (13.04.17 22:40) [7]

    >  а примерчик просто для иллюстрации механизма


    В твоем примере нет места, где может возникать out of memory.
    Вызов Application.ProcessMessages к утечкам не приводит, присвоение символам строки восклицательного знака тоже не приводит.

    Скачай FastMM, вставь его первым юнитом в проекте, включи отчет об утечках в файл и все косяки сразу станут видны.
  • NoUser © (13.04.17 23:33) [8]
    fics, пришло время познакомится с тёмной стороной Application.ProcessMessages;

    > DVM ©   (13.04.17 22:06) [6]
    > В этом коде нет утечек.

    +1

    > Игорь Шевченко ©   (13.04.17 22:40) [7]
    >В твоем примере нет места, где может возникать out of memory.

    -1

    procedure TForm1.Button1Click(Sender: TObject);
    const
    L = 20*1024*1024*SizeOf(Char);     // 20M File.txt
    var
    i : Integer;
    M : Int64;
    begin
    Tag := Tag + 1;                    // Alloc

    M := Int64(Tag) * L;
    if ( M > MaxInt )
      then Halt;

    Caption := IntToStr(M);

    for i:=1 to L div SizeOf(Char)
      do Application.ProcessMessages;  // -> Button1Click x 50 == out of memory // !

    Tag := Tag - 1;                    // Free
    end;


    P.S.
    ... , в какие города,
    И где найти нам средство,
    Чтоб вновь попасть туда.
    ))
  • Игорь Шевченко © (14.04.17 10:20) [9]
    NoUser ©   (13.04.17 23:33) [8]

    А где утечка-то ?
  • NoUser © (14.04.17 13:53) [10]
    Как таковой утечки нет. Но если Button1Click полностью не отработает до следующего нажатия пользователем Button1, то из внутренностей Application.ProcessMessages (которая находится в этом же Button1Click) будет произведён ёще один вызов Button1Click. И так далее, что при неблагоприятном стечении обстоятельств (быстрый пользователь или длинный цикл/большой файл обработки ) приведёт к исчерпанию доступной памяти, выделенной процессу.

    Ранее ТСу было предложено как не допустить подобного, при решении его задачи (раскраска редактируемого текста), через использование примитивных флажков. Но этот приём не был принят на вооружение.
  • fics © (14.04.17 21:01) [11]
    Флажки тут не помогут, помогут только сократить процессорное время до времени обработки. с момента последнего нажатия клавиши, т.е. если по одному нажатию текст обрабатывается до конца 1-сек и нажали подряд 10 раз то уйдет не (10 сек минус время сколько ушло на нажатие), а именно 1-сек, а вот память все равно накидываетя. Так что прием был учтен.

    Р.S ТСу - как расшифровывается?
  • Inovet © (14.04.17 21:48) [12]
    > [11] fics ©   (14.04.17 21:01)
    > Р.S ТСу - как расшифровывается?

    Топик стартеру - автору темы на форуме.
  • NoUser © (14.04.17 22:57) [13]
    > fics ©   (14.04.17 21:01) [11]
    Флажки тут не помогут


    Ну, расcкажи циклу, что уже новое нажатие, как-то по-другому, может тогда он не будет и память 'накидывать'.
  • Rouse_ © (15.04.17 11:09) [14]
    Нет здесь утечки, обычная дефрагментация. Sha показывал кусок кода, которым еще быстрее можно на неё выйти
    Зы: хотя именно вот этот пример не должен так дробить страницы менеджера
  • fics © (15.04.17 16:22) [15]

    > Rouse_ ©   (15.04.17 11:09) [14]

    Что Делать ? :)
  • DVM © (15.04.17 16:28) [16]

    > Что Делать ? :)

    Не копировать строки по 30 мегабайт по сто раз.
  • NoUser © (15.04.17 21:42) [17]
    > Что Делать :
    procedure TForm1.Button1Click(Sender: TObject);      // точка Ы
    var
    i : Integer;
    S : String;
    begin
    if ( Tag <> 0)                                      // косвенная рекурсия ? (сработал телепорт ?)
     then begin                                         // да !
      Tag := 0;                                         // скажем что есть новые данные
      Exit;                                             // и свалим
     end;

    i := 1;                                             // загрузка
    S := StringList.Text;                               //   данных
    Tag := 1;                                           // погнали

    while (i <= Length(S)) do begin
      Application.ProcessMessages;                      // если повезёт, нас телепортируют в точку Ы

      if ( Tag = 0 )                                    // новые данные ?
       then begin                                       // да !
        i := 1;                                         // загрузка
        S := StringList.Text;                           //   данных
        Tag := 1;                                       // погнали
        Continue;                                       // дальше
       end;

      // ...                                            // ночью в поле негры пашут

      Inc(i);
    end;

    Tag := 0;                                           // хух!
    end;
  • sniknik © (17.04.17 10:46) [18]
    > Но если Button1Click полностью не отработает до следующего нажатия
    procedure TForm1.Button1Click(Sender: TObject);
    begin
     TButton(Sender).Enabled:= false;
     try
       ...
     finally
       TButton(Sender).Enabled:= true;
     end;
    end;

 
Конференция "Начинающим" » Куда уходит память? [D7]
Есть новые Нет новых   [118638   +31][b:0][p:0.002]