Problème d'affectation d'un objet lors d'un Create

Version imprimable

Bonjour,

Je viens de faire un code représentatif de ce que je souhaite obtenir.

A savoir, déclarer une classe ancêtre ne connaissant que l'interface de l'objet, et dont l'instanciation fournisse un objet d'une classe descendante, qui implémente les méthodes. Afin de déléguer les détails du descendant à une autre unité ou librairie.

Ce type de code fonctionne en Delphi 5, mais je me heurte au portage sous Lazarus 0.9.30 FPC 2.4.2 Windows 7 :

Code:

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
type
  TMonAncetre = class(TObject) // classe de base
  private
    FField: integer;
  public
    constructor Create(aParam: integer); overload;
    function GetTruc: integer; virtual; abstract;
  end;
 
  TMonFils = class(TMonAncetre) // descendant chargé de l'implémentation
  private
    FTruc: integer;
  public
    constructor Create(aParam: integer);
    function GetTruc: integer;
  end;
 
constructor TMonFils.Create(aParam: integer);
begin
  inherited;
  FField:=aParam;
  FTruc:=-1;
end;
 
function TMonFils.GetTruc: integer;
begin
  Result:=FTruc*FField;
end;
 
function CreateFils(aParam: integer): TMonAncetre; // fonction (CallBack si déclarée ailleurs) qui crée l'objet désiré
begin
  Result:=TMonFils.Create(aParam);
end;
 
constructor TMonAncetre.Create(aParam: integer); // seule fonction à implémenter pour l'ancêtre
var
  temp: TMonAncetre;
begin
  // syntaxe initiale fonctionnelle en Delphi : self:=CreateFils(aParam);
  temp:=CreateFils(aParam);
  self:=temp; // le problème se pose là, je crois... mais pb de débugger
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var
  TestObject: TMonAncetre;
begin
  TestObject:=TMonAncetre.Create(123);
  ShowMessage(IntToStr(TestObject.GetTruc));
  TestObject.Free;
end;

Merci pour vos idées.

12/06/2011, 16h10
Paul TOTH
argh, non ça tu peux le faire en JavaScript où les objets sont dynamiques mais pas sous Delphi :)

Tu prend le problème dans le mauvais sens, l’ancêtre est la base dont hérite le dérivé, tu dois donc créer un TMonFils pour avoir un fils ! Mais tu peux le traiter comme un TMonAncetre dont il dérive. Si tu crées un TMonAncetre, il ne peut pas devenir un TMonFils en modifiant Self.
Code:

1 2 3 4 5 6 var TestObject: TMonAncetre; begin TestObject:=TMonFils.Create(123); end;

j'ai eu un gros instant de doute, le code que je reprends étant bien vieux, et schématisé pour tester sous Lazarus.

Je viens donc de tester ce code sous D5 : il passe sans problème.

Je crée bien un fils, mais pas de père : son Create affecte simplement un fils à self, donc à la variable qui le référence, qui est de type ancêtre et contiendra donc (à l'insu de son plein gré)... un fils !

Ici, le code ne sépare pas ce qui est scindé en 2 unités, mais ça permet d'isoler interface et implémentation, même si c'est un peu (!) à l'arrache.

Code:

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
type
  TMonAncetre = class(TObject) // classe de base
  private
    FField: integer;
  public
    constructor Create(aParam: integer); overload;
    function GetTruc: integer; virtual; abstract;
  end;
 
  TMonFils = class(TMonAncetre) // descendant chargé de l'implémentation
  private
    FTruc: integer;
  public
    constructor Create(aParam: integer);
    function GetTruc: integer; override;
  end;
 
constructor TMonFils.Create(aParam: integer);
begin
  inherited Create;
  FField:=aParam;
  FTruc:=-1;
end;
 
function TMonFils.GetTruc: integer;
begin
  Result:=FTruc*FField;
end;
 
function CreateFils(aParam: integer): TMonAncetre; // fonction qui renvoie l'objet désiré (fils) dans un type ancêtre 
begin
  Result:=TMonFils.Create(aParam);
end;
 
constructor TMonAncetre.Create(aParam: integer); // seule fonction à implémenter pour l'ancêtre
begin
  self:=CreateFils(aParam); // "loge" donc un fils dans un ancêtre
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var
  TestObject: TMonAncetre;
begin
  TestObject:=TMonAncetre.Create(123);
  if TestObject is TMonAncetre then ShowMessage('ancêtre'); // il l'est
  if TestObject is TMonFils
  then ShowMessage('descendant') // il l'est aussi
  else ShowMessage('ne suis-je plus fils ?');
  ShowMessage(IntToStr(TestObject.GetTruc)); // renvoie bien -123
  TestObject.Free;
end;

sous Lazarus, le code suivant continue de ne pas faire ce que je souhaite !

Code:

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
implementation
 
{$R *.lfm}
 
{$ASMMODE intel}  
 
type
  TMonAncetre = class(TObject)
  private
    FField: integer;
  public
    constructor Create(aParam: integer); overload;
    function GetTruc: integer; virtual; abstract;
  end;
 
  TMonFils = class(TMonAncetre)
  private
    FTruc: integer;
  public
    constructor Create(aParam: integer);
    function GetTruc: integer; override;
  end;
 
constructor TMonFils.Create(aParam: integer);
begin
  inherited Create;
  FField:=aParam;
  FTruc:=-1;
end;
 
function TMonFils.GetTruc: integer;
begin
  Result:=FTruc*FField;
end;
 
function CreateFils(aParam: integer): TMonAncetre;
var
  temp: TMonAncetre;
begin
  temp:=TMonFils.Create(aParam);
  Exit(temp);
end;
 
constructor TMonAncetre.Create(aParam: integer);
var
  temp: TMonAncetre;
begin
  temp:=CreateFils(aParam);
   if temp is TMonFils then ShowMessage('descendant'); // OK
   if temp is TMonAncetre then ShowMessage('ancêtre'); // OK, il est bien les 2
  asm
    MOV EAX, temp  // équivalent de self:=temp; ???
  end;
end;
 
{ TForm1 }
 
procedure TForm1.Button2Click(Sender: TObject);
var
  TestObject: TMonAncetre;
begin
  TestObject:=TMonAncetre.Create(123);
  if TestObject is TMonAncetre then ShowMessage('ancêtre'); // OK
  if TestObject is TMonFils
  then ShowMessage('descendant')
  else ShowMessage('ne suis-je donc pas le fils de mon père ?'); // n'est plus un descendant
  ShowMessage(IntToStr(TestObject.GetTruc)); // lève donc logiquement une RunError(211) = appel de méthode abstraite
  TestObject.Free;
end;

Mon problème se situe donc dans l'affectation self:=CreateFils(aParam); de TMonAncetre.Create, qui ne fournit pas le même résultat qu'en D5.

Je viens de lire des guides FPC où la structure des classes a l'air identique à celle de Delphi, et les conventions de stockage dans les registres itou.

Je nage...

12/06/2011, 21h15
Paul TOTH
le constructor doit être codé différemment sous Lazarus

ceci dit, le code s'il fonctionne sous D5 est une erreur de programmation, l'objet instancié dans Self est perdu au profit d'un nouveau, il restera donc en mémoire jusqu'à la fin du programme.

à la rigueur tu peux utiliser une méthode de class, mais je n'en vois pas l'intérêt, autant appeler directement CreerMonFils ou TMonFils.Create...
Code:

1 2 3 4 5 class function TMonAncetre.Creation(aParam : Integer):TMonAncetre; begin Result := CreerMonFils(aParam); end;
13/06/2011, 10h33
tourlourou

Au départ, je souhaitais exposer un prototype d'objet servant d'interface.

Ainsi, l'ancêtre devait être le seul objet visible des unités où il devait être manipulé, tout comme la fonction permettant d'en renvoyer une instance.

La "mécanique" étant logée dans une dll exportant la fonction de création d'instance ancêtre (seul type connu de l'extérieur) mais renvoyant en fait un descendant, qui implémente les méthodes ancêtres virtuelles.

L'unité utilisatrice ne connaît pas d'objet descendant et ne peut donc utiliser que des CreateAncetre externe ou TAncetre.Create qui l'encapsule.

Le polymorphisme permet bien de loger un descendant dans une variable de type ancêtre, ce qui est bien l'un de ses intérêts...

Cela dit, ce schéma revient pê à singer le fonctionnement des interfaces, qui aurait été plus adapté.

La solution de class function que tu proposes est effectivement plus adaptée dans ce schéma, évitant en plus la fuite mémoire que je n'avais pas vue (il y a bien construction et "abandon" d'un objet, heureusement "petit" : ni champs ni méthodes).

Je viens de tester avec succès la solution avec fonction de classe sous D5 et Lazarus : problème résolu (pê pas de manière orthodoxe, optimale, ni élégante !)

Merci beaucoup pour ta science :D