线程、内存泄露问题 顺便过年散分

Question

同事写的一个简单的测试程序，用定时器往TList里加对象，另外开一个线程进行扫描TList，发现里面有对象就释放掉对象。但是时间长了会内存泄露，在任务管理器里可以看到进程不断增加。看了半天没找出问题，代码如下：unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Timer1: TTimer;
    Button3: TButton;
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation
uses
  Unit2;var
  mythread:repthread;
{$R *.dfm}procedure TForm1.Timer1Timer(Sender: TObject);
var
  newtestclass:testclass;
begin
  mythread.cs.Enter;
  newtestclass:=testclass.Create;
  newtestclass.val:=100;
//  newtestclass.buflen:=100;
//  setlength(newtestclass.buf,newtestclass.buflen);
  mythread.replist.Add(newtestclass);
  mythread.cs.Leave;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
  Timer1.Enabled:=true;
end;procedure TForm1.Button2Click(Sender: TObject);
begin
  Timer1.Enabled:=false;
end;procedure TForm1.Button3Click(Sender: TObject);
begin
  mythread:=repthread.Create(false);
end;end.unit Unit2;interfaceuses
  Classes,SyncObjs,SysUtils;type
  testclass=class
    val:integer;
//    buf:array of byte;
//    buflen:integer;
//    public
//    destructor  Destroy; override;
  end;
type
  repthread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  public
    replist:TLIST;
    RUNing:boolean;
    cs:TCriticalSection;
  end;implementationuses Unit1;{ repthread }procedure repthread.Execute;
var
  ACTtestclass:testclass;
  Index: Integer;
begin
  { Place thread code here }
  replist:=TLIST.Create;
  RUNing:=true;
  cs:=TCriticalSection.Create;
  while RUNing do
  begin
    cs.Enter;
    if replist.Count>0 then
    begin
     { ACTtestclass:=testclass(replist.Items[0]);
      replist.Delete(0);
//      setlength(ACTtestclass.buf,0);
      ACTtestclass.Destroy;
      replist.Pack;     }
      Index := RepList.Count - 1;
      if RepList.Items[Index] <> nil then
      begin
        TObject(RepList.Items[Index]).Free;
        RepList.Delete(Index);
      end;
    end
    else
    begin
      sleep(100);
    end;
    cs.Leave;
  end;
  cs.Free;
end;
{destructor testclass.Destroy;
begin
  inherited;
end;}
end.

Answer 1

unit Unit2;interfaceuses
  Classes,SyncObjs,SysUtils;type
  testclass=class
    val:integer;
//    buf:array of byte;
//    buflen:integer;
//    public
//    destructor  Destroy; override;
  end;
type
  repthread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  public
    replist:TLIST;
    RUNing:boolean;
    cs:TCriticalSection;
  end;implementationuses Unit1;{ repthread }procedure repthread.Execute;
var
  ACTtestclass:testclass;
  Index: Integer;
begin
  { Place thread code here }
  replist:=TLIST.Create;   // 對象在什麼地方收集的？？？
  RUNing:=true;
  cs:=TCriticalSection.Create;
  while RUNing do
  begin
    cs.Enter;
    if replist.Count>0 then
    begin
      Index := RepList.Count - 1;
      if RepList.Items[Index] <> nil then
      begin
        TObject(RepList.Items[Index]).Free;   //這樣寫，釋入的對象是？？
        RepList.Delete(Index);
      end;
    end
    else
    begin
      sleep(100);
    end;
    cs.Leave;
  end;
  cs.Free;
end;

Answer 2

replist:=TLIST.Create;    // 這個應該是線程建立時建立吧？？ 

Answer 3

{destructor testclass.Destroy;
begin
  inherited;
end;}这代码为什么隐藏掉呀

Answer 4

现在就是TList就是在线程启动时建立的

Answer 5

一开始以为是TestClass里面的对象变长数组有泄露，就改成一个整形变量，析构也就去掉了，结果还是有问题。

Answer 6

unit Unit2;interfaceuses
  Classes,SyncObjs,SysUtils;type
  testclass=class
    val:integer;
//    buf:array of byte;
//    buflen:integer;
//    public
//    destructor  Destroy; override;
  end;
type
  repthread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  public
    replist:TLIST;
    RUNing:boolean;
    cs:TCriticalSection;
    constructor Create(CreateSuspended: Boolean); overload;
  end;implementationuses Unit1;{ repthread }
procedure repthread.Create(CreateSuspended: Boolean);
begin
  inherited create; 
 { Place thread code here }
  replist:=TLIST.Create;
  RUNing:=true;
  cs:=TCriticalSection.Create;  // 建立臨界限   ，如果放在EXECUTE裏那不亂了。
end;procedure repthread.Execute;
var
  ACTtestclass:testclass;
  Index: Integer;
begin  while RUNing do
  begin
    cs.Enter;
    if replist.Count>0 then
    begin
     { ACTtestclass:=testclass(replist.Items[0]);
      replist.Delete(0);
//      setlength(ACTtestclass.buf,0);
      ACTtestclass.Destroy;
      replist.Pack;     }
      Index := RepList.Count - 1;
      if RepList.Items[Index] <> nil then
      begin
        TObject(RepList.Items[Index]).Free;
        RepList.Delete(Index);
      end;
    end
    else
    begin
      sleep(100);
    end;
    cs.Leave;
  end;
  cs.Free;
end;
{destructor testclass.Destroy;
begin
  inherited;
end;}
end.

Answer 7

procedure TForm1.Timer1Timer(Sender: TObject);//后面執行這個事件
var
  newtestclass:testclass;
begin
  mythread.cs.Enter;  //在主線程執行時，調用子線程的東西，這時系統會是什么狀況？
  newtestclass:=testclass.Create;
  newtestclass.val:=100;
//  newtestclass.buflen:=100;
//  setlength(newtestclass.buf,newtestclass.buflen);
  mythread.replist.Add(newtestclass);
  mythread.cs.Leave;
end;
procedure TForm1.Button3Click(Sender: TObject);//你應該是先執行這個事件
begin
  mythread:=repthread.Create(false);
end;線程代碼中的臨界區以及list的創建是在execute中的，應該是屬于線程的范疇。
你可以把這兩個對象放到子線程的create構造方法里面，或者放到主線程創建，這樣應該就不會有問題了。

Answer 8

临界设置是有点问题
放到Execute外创建

Answer 9

 問題太大了，再改進下；
unit Unit2;interfaceuses
  Classes,SyncObjs,SysUtils;type
  testclass=class
    val:integer;
//    buf:array of byte;
//    buflen:integer;
//    public
//    destructor  Destroy; override;
  end;
type
  repthread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  public
    replist:TLIST;
    RUNing:boolean;
    cs:TCriticalSection;
    constructor Create(CreateSuspended: Boolean); overload;
    destructor Destroy; override;
  end;implementationuses Unit1;{ repthread }
procedure repthread.Create(CreateSuspended: Boolean);
begin
  inherited create; 
 { Place thread code here }
  replist:=TLIST.Create;
  RUNing:=true;
  cs:=TCriticalSection.Create;  // 建立臨界限   ，如果放在EXECUTE裏那不亂了。
end;destructor repthread.Destroy;
begin
  Runing := false;
  if Assigned(repList) then FreeAndNil(repList);
  cs.free;
  inherited Destroy;
end;procedure repthread.Execute;
var
  ACTtestclass:testclass;
  Index: Integer;
begin  while RUNing do
  begin
    cs.Enter;
    if replist.Count>0 then
    begin
      Index := RepList.Count - 1;
      if RepList.Items[Index] <> nil then
      begin
        TObject(RepList.Items[Index]).Free;
        RepList.Delete(Index);
      end;
    end
    else
    begin
      sleep(100);
    end;
    cs.Leave;
  end;
end;
{destructor testclass.Destroy;
begin
  inherited;
end;}
end.

Answer 10

就算将TCriticalSection和TList对象放到Create里面，还是会有内存泄露的，你们可以试试看的

Answer 11

要注意的你 testclass 有沒有申請其它的內存，在FREE的時候是不是沒有釋放。還有內存增加過快，釋放需要一定的時間。

Answer 12

综合timer时间间隔、线程优先级和临界区等其他因素考虑，子线程得到释放主 线程对象的机会有多少呢？当然还要考虑楼上的说法

Answer 13

哈哈，我明天才回家过年。
楼主，把timer时间间隔，设长一点，再看内存状况

Answer 14

延长timer时间,或者加上控制权移交的语句,比如Application.ProcessMessages,试试

Answer 15

我也遇到过这个问题！~ 某个对象没有释放或者释放不是时候。。 你那个临界区没必要在线程执行过程里创建再释放掉！~应该在线程初始化里创建。注意你的timer里还用到临界区呢！~  解决办法：你把线程里的cs.Free去掉！~临界区初始化在线程初始化里创建！

Answer 16

  //应该是线程同步的问题，用ThreadList做多好，LZ非要自己实现一遍ThreadList的功能...... 
  

Answer 17

太久没用，都忘记有ThreadList这东西了