Création de type commandé appellera finaliser le retour

Question

Je veux créer une fonction pour la création et l'initialisation d'un type commandé (un peu comme une usine) de la manière suivante:

function Create return Controlled_Type 
is 
    Foo : Controlled_Type; 
begin 
    Put_Line ("Check 1") 
    return Foo; 
end Create; 

procedure Main 
is 
    Bar : Controlled_Type := Create; 
begin 
    Put_Line ("Check 2") 
end Main; 

output: 
Initialize 
Check 1 
Adjust 
Finalize 

Comme le Finaliser disposera de certains objets pointés dans le type contrôlé I se retrouvent avec des pointeurs qui pendent dans Bar, et d'une manière ou d'une autre cela bloque immédiatement le programme, donc je ne vois jamais "Check 2".

Ceci peut être facilement résolu en utilisant un nouveau Controlled_Type et en renvoyant un pointeur dans la fonction Create. Cependant, j'aime l'idée d'avoir le type contrôlé et non pas un pointeur car la finalisation sera automatiquement appelée quand Bar sortira de sa portée. Si Bar était un pointeur, je devrais m'en débarrasser manuellement.

Y at-il un moyen de le faire correctement sans se retrouver avec des pointeurs pendants? Devrais-je faire un peu de magie dans la procédure Ajuster?

Answer 1

Eh bien, vous devez implémenter Adjustde façon appropriée! Lorsque vous effectuez une copie, elle est au format bit, donc tout pointeur de l'original est copié tel quel dans la copie. Lorsque l'original est finalisé et que l'objet pointé est désalloué, il vous reste un pointeur vers l'hyperespace dans la copie.

La chose à faire est d'allouer un nouveau pointeur, désignant la même valeur que l'original. Quelque chose comme

with Ada.Finalization; 
with Ada.Text_IO; use Ada.Text_IO; 
with Ada.Unchecked_Deallocation; 

procedure Finalart is 

    type Integer_P is access Integer; 
    type Controlled_Type is new Ada.Finalization.Controlled with record 
     P : Integer_P; 
    end record; 
    procedure Initialize (This : in out Controlled_Type); 
    procedure Adjust (This : in out Controlled_Type); 
    procedure Finalize (This : in out Controlled_Type); 

    procedure Initialize (This : in out Controlled_Type) is 
    begin 
     Put_Line ("initialize"); 
     This.P := new Integer'(42); 
    end Initialize; 

    procedure Adjust (This : in out Controlled_Type) is 
     Original_Value : constant Integer := This.P.all; 
    begin 
     Put_Line ("adjust"); 
     This.P := new Integer'(Original_Value); 
    end Adjust; 

    procedure Finalize (This : in out Controlled_Type) is 
     procedure Free is new Ada.Unchecked_Deallocation (Integer, Integer_P); 
    begin 
     Put_Line ("finalize"); 
     Free (This.P); 
    end Finalize; 

    function Create return Controlled_Type is 
     CT : Controlled_Type; 
    begin 
     Put_Line ("check 1"); 
     return CT; 
    end Create; 

    Bar : Controlled_Type := Create; 
begin 
    Put_Line ("check 2"); 
end Finalart; 

Si je commente la ligne This.P := new Integer'(Original_Value); à Adjust, je reçois (sur macOS)

$ ./finalart 
initialize 
check 1 
adjust 
finalize 
adjust 
finalize 
finalart(35828,0x7fffd0f8b3c0) malloc: *** error for object 0x7fca61500000: pointer being freed was not allocated 
*** set a breakpoint in malloc_error_break to debug 

raised PROGRAM_ERROR : unhandled signal