Discussion :

[popo]

Bonjour,

Je mets en place des tests unitaires (avec DUnit si ça a une importance) et j'ai besoin de vérifier que l'un des objets implémente la bonne interface. J'utilise donc la fonction "Supports".

Le problème est que je ne peut pas libérer mon objet sans que ça plante avec le message

TestLegacy: EInvalidPointer at $007D9689
Opération de pointeur incorrecte

Si j'enlève le support cela fonctionne. J'ai également enlevé le CheckTrue histoire d'être certain que rien n'interfère.

Ceci fonctionne

Code Delphi :

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

1
2
3
4
5
6
7
8
9
10
procedure TExportInterfacingTest.TestDirectInterfacing;
var ExportObject : TDirectoryImportExport;
begin
  ExportObject := TDirectoryImportExport.Create(dimOutlook,demOutlook);
  try
    //CheckTrue(ExportObject.ReturnMessage = '');
  finally
    ExportObject.Free;
  end;
end;

Ceci plante

Code Delphi :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure TExportInterfacingTest.TestLegacy;
var ExportObject : TDirectoryImportExport;
    ExportInterface : IDirectoryExport;
    OK : Boolean;
begin
  ExportObject := TDirectoryImportExport.Create(dimOutlook,demOutlook);
  try
    OK := Supports(ExportObject,IDirectoryExport,ExportInterface);
    //CheckTrue(OK = True);
  finally
    { Obligé de mettre le Free en commentaire sinon ça plante ! }
    ExportObject.Free;
  end;
end;

J'ai bien essayé de regarder ce qui se passe dans la fonction "Supports" avec F7 mais je tombe sur de l'assembleur auquel j'avoue ne pas connaître grand chose.

Mon test unitaire passe parfaitement si j'enlève le Free mais je trouve ça très sale.

[guillemouze]

La plupart des interfaces en delphi se liberent automatiquement quand on passe leur pointeur à nil. En fait, quand tu affecte queleque chose à un pointeur d'interface, le compilateur le remplace automatiquement par un _AddRef. et quand tu change la valeur du pointeur (passage a nil par exemple), ca appelle automatiquement _Release, qui lui meme libere l'objet si le compteur d'interface (incrémenté à chaque _AddRef, et décrémenté à chaque _Release) passe à 0.

Dans ton ca, cela donne :

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
 
procedure TExportInterfacingTest.TestLegacy;
var ExportObject : TDirectoryImportExport;
    ExportInterface : IDirectoryExport;
    OK : Boolean;
begin
  ExportObject := TDirectoryImportExport.Create(dimOutlook,demOutlook);
  try
    OK := Supports(ExportObject,IDirectoryExport,ExportInterface); // = ExportObject._addRef -> ExportObject.CompteurDeReference=1
    //CheckTrue(OK = True);
  finally
    { Obligé de mettre le Free en commentaire sinon ça plante ! }
    ExportObject.Free; //destruction de l'objet, mais l'interface "ExportInterface" pointe toujours dessus
  end;
end; // Liberation implicite de ta variable locale "ExportInterface", donc appel automatique de Release sur ton instance que tu as liberé

Il faut que tu le remplace ainsi :

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
 
procedure TExportInterfacingTest.TestLegacy;
var ExportObject : TDirectoryImportExport;
    ExportInterface : IDirectoryExport;
    OK : Boolean;
begin
  ExportObject := TDirectoryImportExport.Create(dimOutlook,demOutlook);
  try
    ExportInterface := nil;
    OK := Supports(ExportObject,IDirectoryExport,ExportInterface);
    //CheckTrue(OK = True);
  finally
    { Obligé de mettre le Free en commentaire sinon ça plante ! }
    if ExportInterface <> nil then
      ExportInterface := nil // liberation de l'objet en auto
    else
      ExportObject.Free; //liberation manuelle car l'interface n'a pas liberé l'objet
  end;
end;

ou alors, en se passant du TObject et en n'utilisant que les interfaces :

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
 
procedure TExportInterfacingTest.TestLegacy;
var ExportInterface : IDirectoryExport;
    OK : Boolean;
begin
  ExportInterface := nil;
  try
    ExportInterface := TDirectoryImportExport.Create(dimOutlook,demOutlook);
    OK := True;
  except
    OK := False
  end;
  //CheckTrue(OK = True);
  ExportInterface := nil; // Facultatif, fait en auto sur le end de la fonction sinon
end;

mais je serais tenté de dire que la compilation va planter à la ligne

Code :

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

    ExportInterface := TDirectoryImportExport.Create(dimOutlook,demOutlook);

si l'objet n'implemente pas l'interface

[ShaiLeTroll]

C'est normal, Supports va incrémenter le compteur de référence via AddRef (QueryInterface) de ton objet
Lors que tu sors de la fonction (sur le end) comme ExportInterface contient une référence sur une interface, il va donc faire un Release, le compteur tombe à zéro et donc le libère, ton free faisant lui aussi la libération tu as une violation d'accès
je pense que ton free est le 1er à s'executer, donc le Release doit utiliser un compteur de référence sur une zone mémoire déjà libérée

en plus c'est même écrit en Avertissement dans la doc:

A l'exception de la surcharge qui vérifie si TClass implémente une interface, toutes les autres versions de Supports vont extraire une référence d'interface à partir d'un objet ou d'une autre référence d'interface, en causant l'incrémentation du compteur de références de l'objet dépendant, puis vont libérer l'interface à la sortie (en décrementant le compteur de références). Si le compteur de références d'un objet atteint zéro, l'objet sera détruit

Code :

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

1
2
3
4
5
6
var 
  Obj: TInterfacedObject;
begin
  Obj := TInterfacedObject.Create;
  if Supports(Obj, IInterface) then { ... à ce moment, Obj sera libéré }
end;

en conservant le Create (utile si l'on veut tester Supports sur le résultat d'une Factory mais pas forcément utile dans le cas où la class est connue à la compilation comme c'est le cas ici)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure TExportInterfacingTest.TestLegacy;
var ExportObject : TDirectoryImportExport;
   OK : Boolean;
begin
  ExportObject := TDirectoryImportExport.Create(dimOutlook,demOutlook);
  try
    OK := Supports(ExportObject, IDirectoryExport); // deux paramètre c'est suffisant !  
  finally
    if not OK then // pour éviter une double libération
      ExportObject.Free;
  end;
 
  CheckTrue(OK);
end;

avec justement TClass (le mieux non ?)

Code :

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

1
2
3
4
5
6
procedure TExportInterfacingTest.TestLegacy;
var OK : Boolean;
begin
  OK := Supports(TDirectoryImportExport, IDirectoryExport);
  CheckTrue(OK);
end;

ou encore

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
procedure TExportInterfacingTest.TestLegacy;
var ExportObject : TDirectoryImportExport;
    ExportInterface : IDirectoryExport;
    OK : Boolean;
begin
  ExportObject := TDirectoryImportExport.Create(dimOutlook,demOutlook);
  try
    ExportInterface := ExportObject as IDirectoryExport;
    OK := true;
  except 
    on Exception do // EInvalidCast normalement
    begin
      OK := false;
      ExportObject.Free;
    end;    
  end;
 
  CheckTrue(OK);
end;

EDIT : guillemouze, ta 2eme solution n'aurait pas une fuite mémoire ?
si le as échoue, il n'y a pas d'affectation dans l'interface donc l'objet créer avec un support incomplet ne sera pas libéré

[popo]

Merci à vous deux. Je n'aurai jamais pensé au compteur de référence.

en plus c'est même écrit en Avertissement dans la doc:

J'utilise Delphi 7. Cette partie là n'est pas spécifié. Il est par contre écrit que ça utilise QueryInterface. Aucune trace de pas _addRef.
En tout cas, je le saurais pour la prochaine fois.


Je comptais faire d'autre test sur l'objet après avoir fait le Supports. Finalement, je vais mélanger les deux sauces.

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
procedure TImportInterfacingTest.TestLegacy;
var ImportObject : TDirectoryImportExport;
    OK : Boolean;
begin
  OK := Supports(TDirectoryImportExport,IDirectoryImport);
  CheckTrue(OK);
  if (OK) then
  begin
    ImportObject := TDirectoryImportExport.Create(dimOutlook,demOutlook);
    try
      ...  
    finally
      ImportObject.Free;
    end;
  end;
end;

[guillemouze]

Je comptais faire d'autre test sur l'objet après avoir fait le Supports. Finalement, je vais mélanger les deux sauces.

Ca me semble tres bien.
Je crois que tu peux aussi faire Support(UneInstanceDObject, IQuelquechose), auquel cas il ne va pas demander de pointeur sur l'interface, donc pas de _AddRef, ...