Discussion :

[ouiouioui]

Bonjour, j'ai crée une class dérivé de tlist sa fonctionne mais a la sortie delphi me dis (j'utilise ReportMemoryLeaksOnShutDown := true:

Unexpected Memory Leak
---------------------------
An unexpected memory leak has occurred. The unexpected small block leaks are:

13 - 20 bytes: Unknown x 1

Si je clique 2 fois sa passe à x2 etc.
Dans memproof sa n'apparait pas et en pas à pas je vois que ma liste et mon item est libéré j'arrive pas à comprendre. merci d'avance pour votre aide

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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
Unit GameServerDetails;
 
Interface
 
Uses
  Windows, Messages, SysUtils, Variants, Classes;
 
Type
  TGameServerRulesDetails = Class
  Private
    FName, FValue: String;
  Public
    Constructor Create(Name, Value: String);
    Property Name: String Read FName;
    Property Value: String Read FValue;
  End;
 
  TGameServerRulesList = Class(TList)
  Private
    Function GetItem(Idx: Integer): TGameServerRulesDetails;
  Public
    Destructor Destroy; Override;
    Function Add(RulesDetails: TGameServerRulesDetails): Integer;
    Function AddRulesDetails(Name, Value: String): Integer;
    Function IndexOf(RulesDetails: TGameServerRulesDetails): Integer;
    Procedure Clear; Override;
    Procedure Insert(Index: Integer; RulesDetails: TGameServerRulesDetails);
    Procedure Delete(Index: Integer);
    Property Items[Idx: Integer]: TGameServerRulesDetails Read GetItem;
  End;
 
  End;
 
Implementation
 
{ TGameServerRulesDetails }
 
Constructor TGameServerRulesDetails.Create(Name, Value: String);
Begin
  FName  := Name;
  FValue := Value;
End;
 
{ TGameServerRulesList }
 
Function TGameServerRulesList.Add(
  RulesDetails: TGameServerRulesDetails): Integer;
Begin
  Result := Inherited Add(RulesDetails);
End;
 
Function TGameServerRulesList.AddRulesDetails(Name, Value: String): Integer;
Var
  RulesDetails: TGameServerRulesDetails;
Begin
  RulesDetails := TGameServerRulesDetails.Create(Name, Value);
  Result       := Add(RulesDetails);
End;
 
Procedure TGameServerRulesList.Clear;
Begin
  While Inherited Count > 0 Do
    Delete(0);
End;
 
Procedure TGameServerRulesList.Delete(Index: Integer);
Begin
  If Index In [0..Count - 1] Then
  Begin
    Items[Index].Free;
    Inherited Delete(Index);
  End;
End;
 
Destructor TGameServerRulesList.Destroy;
Begin
  Try
    Clear;
  Finally
    Inherited Destroy;
  End;
End;
 
Function TGameServerRulesList.GetItem(Idx: Integer): TGameServerRulesDetails;
Begin
  Result := TGameServerRulesDetails(Inherited Items[Idx]);
End;
 
Function TGameServerRulesList.IndexOf(
  RulesDetails: TGameServerRulesDetails): Integer;
Begin
  Result := 0;
  While (Result < Count) And (
      (Items[Result].FName <> RulesDetails.Name) And
      (Items[Result].FValue <> RulesDetails.Value)
    ) Do
    Inc(Result);
  If Result = Count Then
    Result := -1;
End;
 
Procedure TGameServerRulesList.Insert(Index: Integer;
  RulesDetails: TGameServerRulesDetails);
Begin
  Inherited Insert(Index, RulesDetails);
End;
 
End.

appel exemple:

Code :

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

1
2
3
4
5
6
7
8
Procedure TForm1.Button1Click(Sender: TObject);
Var
  t: TGameServerRulesList;
Begin
  t := TGameServerRulesList.Create;
  t.AddRulesDetails('t', '0');
  t.Free;
End;

[Dr.Who]

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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
Unit GameServerDetails;
 
Interface
 
Uses
  Windows, Messages, SysUtils, Variants, Classes;
 
type
  TGameServerRulesDetails = Class
  private
    FOwned : boolean;
    FName  : string;
    FValue : string;
  public
    property Name  : string read FName  write FName;
    property Value : string read FValue write FValue;
  public
    constructor Create(const aOwned: boolean= false); overload;
    Constructor Create(aName, aValue: String; const aOwned: boolean= false); overload;
    procedure Assign(source: TObject);
  end;
 
 
  TGameServerRulesList = Class(TList)
  private
    fFindPos : integer;
    fOwnItems: boolean;
    procedure SetItem(Index: integer; value: TGameServerRulesDetails);
    function GetItem(Index: Integer): TGameServerRulesDetails;
  protected
    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
  public
    Property Items[index: Integer]: TGameServerRulesDetails read GetItem write SetItem;
    property OwnItems : boolean read fOwnItems write fOwnItems default false;
  public
    function Add(aRulesDetails: TGameServerRulesDetails): integer;
    function AddRulesDetails(aName, aValue: String): integer;
    function IndexOf(aRulesDetails: TGameServerRulesDetails): integer;
    function FindIndexOf(aName, aValue: string): integer;
    procedure FindReset;
    procedure Insert(aIndex: Integer; aRulesDetails: TGameServerRulesDetails);
    procedure Delete(aIndex: Integer);
    constructor Create(aOwnItems: boolean); override;
    destructor Destroy; override;
  End;
 
 
Implementation
 
{ TGameServerRulesDetails }
 
procedure TGameServerRulesDetails.Assign(source: TObject);
begin
  if assigned(Source) then
    if Source is TGameServerRulesDetails then
    begin
      FName  := TGameServerRulesDetails(source).FName;
      FValue := TGameServerRulesDetails(source).FValue;
    end;
end;
 
Constructor TGameServerRulesDetails.Create(aName, aValue: String; const aOwned: boolean= false);
begin
  Create(aOwned);
  FName  := aName;
  FValue := aValue;
end;
 
constructor TGameServerRulesDetails.Create(const aOwned: boolean= false);
begin
  FOwned := aOwned;
  FName  := '';
  FValue := '';
end;
 
{ TGameServerRulesList }
 
function TGameServerRulesList.Add(aRulesDetails: TGameServerRulesDetails): Integer;
begin
  Result := Inherited Add(pointer(aRulesDetails));
end;
 
function TGameServerRulesList.AddRulesDetails(aName, aValue: String): Integer;
var
  Item : TGameServerRulesDetails;
begin
  Item   := TGameServerRulesDetails.Create(aName, aValue, true);
  result := add(Item);
end;
 
constructor TGameServerRulesList.Create(aOwnItems: boolean);
begin
  inherited;
  fOwnItems := aOwnItems;
  fFindPos  := 0;
end;
 
procedure TGameServerRulesList.Delete(aIndex: Integer);
begin
  inherited Delete(aIndex);
end;
 
destructor TGameServerRulesList.Destroy;
begin
  Clear;
  inherited Destroy;
end;
 
function TGameServerRulesList.FindIndexOf(aName, aValue: string): integer;
var N    : integer;
    Item : TGameServerRulesDetails;
begin
  result := -1;
  if fFindPos >= Count then
    fFindPos := 0;
 
  if (aName <> '*') and (aValue = '*') then
    for N := fFindPos to Count-1 do
    begin
      Item := Items[N];
      if sameText(Item.FName, aName) then
      begin
        fFindPos := N+1;
        result   := N;
        exit(0);
      end;
    end
  else
  if (aName = '*') and (aValue <> '*') then
    for N := fFindPos to Count-1 do
    begin
      Item := Items[N];
      if sameText(Item.FValue, aValue) then
      begin
        fFindPos := N+1;
        result := N;
        exit;
      end;
    end
  else
    for N := fFindPos to Count-1 do
    begin
      Item := Items[N];
      if sameText(Item.FName, aName) and sameText(Item.FValue, aValue) then
      begin
        fFindPos := N+1;
        result := N;
        exit;
      end;
    end
end;
 
procedure TGameServerRulesList.FindReset;
begin
  fFindPos := 0;
end;
 
Function TGameServerRulesList.GetItem(Index: Integer): TGameServerRulesDetails;
Begin
  Result := TGameServerRulesDetails(Inherited Items[Index]);
End;
 
function TGameServerRulesList.IndexOf(aRulesDetails: TGameServerRulesDetails): Integer;
begin
  result := inherited indexOf(pointer(aRulesDetails));
end;
 
procedure TGameServerRulesList.Insert(aIndex: Integer; aRulesDetails: TGameServerRulesDetails);
begin
  Inherited Insert(aIndex, pointer(aRulesDetails));
end;
 
procedure TGameServerRulesList.Notify(Ptr: Pointer; Action: TListNotification);
var Item : TGameServerRulesDetails;
begin
  if (ptr <> nil) and (Action = lnDeleted) then
  begin
    Item := TGameServerRulesDetails(ptr);
    if Item.fOwned or fOwnItems then
      Item.Free;
  end
  else
   inherited;
end;
 
procedure TGameServerRulesList.SetItem(Index: integer; value: TGameServerRulesDetails);
begin
  Items[index].Assign(Value);
end;
 
End.

attention, dans ton exemple, si tu libère T, l'objet deviens invalide dans la liste!

[ouiouioui]

merci à toi, mais je comprend pas le problème dans mon code.

quand je fait t.free chaque TGameServerRulesDetails est libéré dans la procedure delete avec Items[Index].Free;

donc je vois pas ce qui n'est pas libéré

edit j'ai trouvé:

Code :

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

1
2
3
4
5
6
7
8
Destructor TGameServerRulesList.Destroy;
Begin
  Try
    Clear;
  Finally
    Inherited Destroy;
  End;
End;

Destroy; de TList appel Clear; sauf que la c'est pas le cas donc j'ai remplacé par
Inherited Clear; directement et plus de perte

[guillemouze]

utilise une TObjectList (avec OwnsObjects=true) au lieu d'une TList, ca detruira automatiquement les objets detenus

[Dr.Who]

en fait tu avait surchargé Clear, mais sans appeler l'inherited Clear qui appel deux fonction :

SetCapacity(0) qui vide la liste de pointeurs
SetCount(0) qui appel Delete pour supprimer les pointeurs

Delete appel notify, pour notifier la suppression (lnDeleted) d'un pointeur, c'est donc la methode Notify qu'on surcharge pour signifier que si le pointeur doit être libéré (dispose, free ou autre) on le fait.

l'ajout de paramêtres fOwned dans TGSRD et fOwnItems dans TGSRL permet de controler cette libération.

[ouiouioui]

merci pour ces précieuse explications

du coup j'ai viré mes destroy et corrigé mes clear