Libérer un TThread

**Papy214** · 24/03/2012, 15h57

Bonjour,

J'ai un souci de libération de Thread.
A l'exécution du code ci-dessous, le code se bloque sur le MyThread.Free.
Ca me semble logique puisque je le fais dans OnThreadFini qui un évènement lancé par le thread lui-même.
Si je ne fais pas ce free, FastMM m'annonce que j'ai oublié de libérer l'objet à la fermeture du programme.

---------------------------
Pthread.exe: Memory Leak Detected
---------------------------
This application has leaked memory. The small block leaks are (excluding expected leaks registered by pointer):

53 - 68 bytes: TProgressThread x 1

Note: Memory leak detail is logged to a text file in the same folder as this application. To disable this memory leak check, undefine "EnableMemoryLeakReporting".

---------------------------
OK
---------------------------

Si je mets MyThread.FreeOnTerminate à True, le OnThreadFini déclenche une erreur de descripteur incorrect.

Question: Où faudrait-il faire le free ?

Papy !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SynEdit, StdCtrls, ComCtrls, AbComCtrls;
 
type
 
  TProgressThread = class(TThread)
  private
    CurrentPercentDone: Integer;
    procedure UpdateForm;
  protected
    procedure Execute; override;
  end;
 
  TForm1 = class(TForm)
    AbProgressBar1: TAbProgressBar;
    btn1: TButton;
    syndt1: TSynEdit;
    procedure btn1Click(Sender: TObject);
    procedure OnThreadFini(sender: TObject);
  private
    MyThread: TProgressThread;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
{ TProgressThread }
 
procedure TProgressThread.Execute;
begin
  CurrentPercentDone := 0;
  while (not Terminated) and (CurrentPercentDone < 100) do
  begin
    Inc(CurrentPercentDone);
    Synchronize(Self, UpdateForm);
    Sleep(300);
  end;
  CurrentPercentDone := 0;
  Synchronize(Self, UpdateForm);
end;
 
procedure TProgressThread.UpdateForm;
begin
  (Application.MainForm as TForm1).AbProgressBar1.Position := CurrentPercentDone;
end;
 
procedure TForm1.btn1Click(Sender: TObject);
begin
  if btn1.Tag = 0 then
  begin
    MyThread := TProgressThread.Create(True);
    MyThread.FreeOnTerminate := False;
    MyThread.OnTerminate := OnThreadFini;
    MyThread.Resume;
    btn1.Tag := 1;
    btn1.Caption := 'Stopper';
  end
  else
  begin
    MyThread.Suspend;
    if MessageBox(Self.Handle, PChar('Annuler l''opération ?'), PChar('Stop it ?'), MB_YESNO) = ID_YES then
    begin
      MyThread.Terminate;
      MyThread.Free;
      btn1.Tag := 0;
      btn1.Caption := 'Lancer';
    end
    else
      MyThread.Resume;
  end;
end;
 
procedure TForm1.OnThreadFini(sender: TObject);
begin
  btn1.Tag := 0;
  btn1.Caption := 'Lancer';
  MyThread.Free;
end;
 
end.

**Andnotor** · 24/03/2012, 17h44

Si tu utilises FreeOnTerminate, il ne faut plus faire appel à Free puisque l'objet TThread aura déjà été libéré.

FastMM lui te renvoie l'état de la mémoire à la fin du thread principal. S'il prend moins de temps que le thread secondaire à s’arrêter, un message est affiché. Mais ça ne veut pas dire pour autant que le secondaire n'est pas arrêter et les libérations faites correctement !

En bref, le rapport FastMM n'est pas forcément pertinent avec l'utilisation de FreeOnTerminate

**Papy214** · 24/03/2012, 21h31

oui mais justement, j'ai mis FreeOnTerminate à False.
Je devrais donc pouvoir faire un free ensuite non ?

**Andnotor** · 24/03/2012, 22h43

Bien sûr, mais en respectant la règle qui dit qu'un objet ne peut se détruire lui-même, TThread ou pas !
Tu peux invoquer MyThread.Free depuis un évènement de la fiche (OnClick, OnClose, etc.) mais pas par un Synchronize ou OnTerminate qui sont des méthodes (ou appelé par des méthodes) de TThread.

Dans ton cas, je laisserais FreeOnTerminate, mais à la place d'appeler Free, appelle simplement Terminate qui te fera sortir de la boucle Execute

La libération se fera sans problème puisque c'est la tâche (niveau Windows indépendante de l'objet) qui appellera le destructeur de l'objet. Par contre comme expliqué précédemment, tu risques de recevoir un faux-positif de la part de FastMM si cette tâche secondaire se termine effectivement après la tâche principale (il n'y a aucune synchro entre les deux)

**Papy214** · 24/03/2012, 22h58

Ok, donc, je dois faire un free après ou utiliser FreeOnterminate à True.

Problème avec le code modifié comme suit:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
 
{ TProgressThread }
 
procedure TProgressThread.Execute;
begin
  CurrentPercentDone := 0;
  while (not Terminated) and (CurrentPercentDone < 100) do
  begin
    Inc(CurrentPercentDone);
    Synchronize(Self, UpdateForm);
    Sleep(300);
  end;
  CurrentPercentDone := 0;
  Synchronize(Self, UpdateForm);
  Synchronize(Self, ReinitButton);
end;
 
procedure TProgressThread.ReinitButton;
begin
  With (Application.MainForm as TForm1).btn1 do
  begin
    Tag := 0;
    Caption := 'Lancer';
  end;
end;
 
procedure TProgressThread.UpdateForm;
begin
  (Application.MainForm as TForm1).AbProgressBar1.Position := CurrentPercentDone;
end;
 
procedure TForm1.btn1Click(Sender: TObject);
begin
  if btn1.Tag = 0 then
  begin
    MyThread := TProgressThread.Create(True);
    MyThread.FreeOnTerminate := True;
    MyThread.Resume;
    btn1.Tag := 1;
    btn1.Caption := 'Stopper';
  end
  else
  begin
    MyThread.Suspend;
    if MessageBox(Self.Handle, PChar('Annuler l''opération ?'), PChar('Stop it ?'), MB_YESNO) = ID_YES then
    begin
      MyThread.Terminate;
      btn1.Tag := 0;
      btn1.Caption := 'Lancer';
    end
    else
      MyThread.Resume;
  end;
end;

déclenche l'erreur suivante

---------------------------
Debugger Exception Notification
---------------------------
Project Pthread.exe raised exception class EThread with message 'Thread Error: Descripteur non valide (6)'. Process stopped. Use Step or Run to continue.
---------------------------
OK Help
---------------------------

dans le Execute à la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
...
  CurrentPercentDone := 0;       <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  Synchronize(Self, UpdateForm);
  Synchronize(Self, ReinitButton);

En fait, on dirait que le thread est libéré par le free avant même la fin du Execute. C'est d'ailleurs à partir de ce premier problème que j'avais utilisé FreeOnTerminate à False.

Le problème n'est finalement que de savoir où placer les lignes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
      btn1.Tag := 0;
      btn1.Caption := 'Lancer';

pour qu'elles s'éxécutent quand le thread se termine tout seul sans que je le force à s'arrêter.
:-(

**ouiouioui** · 25/03/2012, 11h18

L'erreur intervient car t'essaye d'utiliser le thread alors qu'il s'est libérer tout seul. Si tu utilise FreeOnTerminate faut tester avec Assigned

Moi je ferai comme sa :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
Unit Unit8;
 
Interface
 
Uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls;
 
Type
 
  TProgressThread = Class(TThread)
  Private
    CurrentPercentDone: Integer;
    Procedure UpdateForm;
  Protected
    Procedure Execute; Override;
  End;
 
  TForm8 = Class(TForm)
    bt1: TButton;
    pb1: TProgressBar;
    Procedure bt1Click(Sender: TObject);
    Procedure FormCreate(Sender: TObject);
  Public
    MyThread: TProgressThread;
    Procedure OnThreadFini(Sender: TObject);
  End;
 
Var
  Form8: TForm8;
 
Implementation
 
{$R *.dfm}
 
{ TProgressThread }
 
Procedure TProgressThread.Execute;
Begin
  CurrentPercentDone := 0;
  While (Not Terminated) And (CurrentPercentDone < 100) Do
  Begin
    Inc(CurrentPercentDone);
    Synchronize(UpdateForm);
    Sleep(300);
  End;
End;
 
Procedure TProgressThread.UpdateForm;
Begin
  Form8.pb1.Position := CurrentPercentDone;
End;
 
{ TForm8 }
 
Procedure TForm8.FormCreate(Sender: TObject);
Begin
  MyThread := NIL;
End;
 
Procedure TForm8.OnThreadFini(Sender: TObject);
Begin
  MyThread := NIL;
  bt1.Caption := 'Lancer';
  pb1.Position := 0;
End;
 
Procedure TForm8.bt1Click(Sender: TObject);
Begin
  If Not Assigned(MyThread) Then
  Begin
    MyThread                 := TProgressThread.Create(True);
    MyThread.FreeOnTerminate := True;
    MyThread.OnTerminate     := OnThreadFini;
    MyThread.Resume;
    bt1.Caption              := 'Stopper';
  End
  Else
  Begin
    MyThread.Suspend;
    If MessageBox(Self.Handle, PChar('Annuler l''opération ?'), PChar('Stop it ?'), MB_YESNO) = mrYes Then
    begin
      MyThread.Resume;
      MyThread.Terminate;
    end
    Else
    Begin
      MyThread.Resume;
    End;
  End;
End;
 
End.

**Andnotor** · 25/03/2012, 12h05

Envoyé par Papy214

Le problème n'est finalement que de savoir où placer les lignes...

OnTerminate est le meilleur endroit. C'est juste Free qu'il faillait supprimer !

Avec FreeOnTerminate, la tâche est détruite après l'appel à Execute

Si tu es sûr de ne plus avoir de Free ailleurs, c'est peut être Suspend qui pose problème. (Suspend/Resume sont de toute façon dépréciés et ne devraient plus être utilisés)

**Papy214** · 25/03/2012, 15h03

Envoyé par Andnotor

. (Suspend/Resume sont de toute façon dépréciés et ne devraient plus être utilisés)

J'oubliais de préciser que je fais ça sur Delphi 7. Suspend et Resume ne sont pas encore dépréciés dans cette version :-)

**Papy214** · 25/03/2012, 15h13

ouiouioui ->

Avec ton code, plus d'erreur et de perte révélée par FastMM4.
Mais là me vient une question. Dans la partie:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Procedure TForm8.OnThreadFini(Sender: TObject);
Begin
  MyThread := NIL;
  bt1.Caption := 'Lancer';
  pb1.Position := 0;
End;

On est un code lancé par MyThread. Et pourtant, on peut faire un MyThread := nil la-dedans mais PAS un MyThread.Free.

Troublant ce truc ! Mais merci !

**ouiouioui** · 25/03/2012, 19h21

Le thread est free auto, donc pas de deuxième Free nécessaire.
on met la variable à NIL pour que if assigned fonctionne.

tu peux virer FreeOnTerminate et remplacer MyThread := NIL; par FreeAndNil(MyThread); sa devrait fonctionner pareil.

**Papy214** · 25/03/2012, 21h01

FreeAndNil plante le programme. Ca freeze et je dois faire un Ctrl F2

Mais c'est bon dans la première forme.

Merci et bonne fin de w-e !

Libérer un TThread

Langage Delphi

Discussions similaires

Partager

Partager