Aspect_Default_Value,
Aspect_Depends, -- GNAT
Aspect_Designated_Storage_Model, -- GNAT
- Aspect_Destructor, -- GNAT
Aspect_Dimension, -- GNAT
Aspect_Dimension_System, -- GNAT
Aspect_Dispatching_Domain,
Aspect_CUDA_Global => True,
Aspect_Depends => True,
Aspect_Designated_Storage_Model => True,
- Aspect_Destructor => True,
Aspect_Dimension => True,
Aspect_Dimension_System => True,
Aspect_Disable_Controlled => True,
Aspect_Default_Value => Expression,
Aspect_Depends => Expression,
Aspect_Designated_Storage_Model => Name,
- Aspect_Destructor => Name,
Aspect_Dimension => Expression,
Aspect_Dimension_System => Expression,
Aspect_Dispatching_Domain => Expression,
Aspect_Default_Value => True,
Aspect_Depends => False,
Aspect_Designated_Storage_Model => True,
- Aspect_Destructor => False,
Aspect_Dimension => False,
Aspect_Dimension_System => False,
Aspect_Dispatching_Domain => False,
Aspect_Default_Value => Name_Default_Value,
Aspect_Depends => Name_Depends,
Aspect_Designated_Storage_Model => Name_Designated_Storage_Model,
- Aspect_Destructor => Name_Destructor,
Aspect_Dimension => Name_Dimension,
Aspect_Dimension_System => Name_Dimension_System,
Aspect_Disable_Controlled => Name_Disable_Controlled,
Aspect_Default_Value => Always_Delay,
Aspect_Default_Component_Value => Always_Delay,
Aspect_Designated_Storage_Model => Always_Delay,
- Aspect_Destructor => Always_Delay,
Aspect_Discard_Names => Always_Delay,
Aspect_Dispatching_Domain => Always_Delay,
Aspect_Dynamic_Predicate => Always_Delay,
+.. role:: ada(code)
+ :language: ada
+
.. _GNAT_Language_Extensions:
************************
Destructors
-----------
-The ``Destructor`` aspect can be applied to any record type, tagged or not.
-It must denote a primitive of the type that is a procedure with one parameter
-of the type and of mode ``in out``:
-
-.. code-block:: ada
-
- type T is record
- ...
- end record with Destructor => Foo;
+The :ada:`Destructor` extension adds a new finalization mechanism that
+significantly differs standard Ada in how it interacts with type derivation.
- procedure Foo (X : in out T);
-
-This is equivalent to the following code that uses ``Finalizable``:
+New syntax is introduced to make it possible to define "destructors" for record
+types, tagged or untagged. Here's a simple example:
.. code-block:: ada
- type T is record
- ...
- end record with Finalizable => (Finalize => Foo);
-
- procedure Foo (X : in out T);
+ package P is
+ type T is record
+ ...
+ end record;
-Unlike ``Finalizable``, however, ``Destructor`` can be specified on a derived
-type. And when it is, the effect of the aspect combines with the destructors of
-the parent type. Take, for example:
+ procedure T'Destructor (X : in out T);
+ end P;
.. code-block:: ada
- type T1 is record
- ...
- end record with Destructor => Foo;
-
- procedure Foo (X : in out T1);
-
- type T2 is new T1 with Destructor => Bar;
-
- procedure Bar (X : in out T2);
+ package body P is
+ procedure T'Destructor (X : in out T) is
+ begin
+ ...
+ end T'Destructor;
+ end P;
-Here, when an object of type ``T2`` is finalized, a call to ``Bar``
-will be performed and it will be followed by a call to ``Foo``.
+Like :ada:`Finalize` procedures, destructors are called on objects just before they
+are destroyed. But destructors are more flexible in how they can used with derived
+types. With standard Ada finalization, when you derive from a finalizable type,
+you must either inherit the :ada:`Finalize` procedure or override it completely.
-The ``Destructor`` aspect comes with a legality rule: if a primitive procedure
-of a type is denoted by a ``Destructor`` aspect specification, it is illegal to
-override this procedure in a derived type. For example, the following is illegal:
+Destructors work differently. You can define a destructor for a type derived from
+a parent type that also has a destructor, and then when objects of the derived type
+are finalized, both destructors will be called. For example:
.. code-block:: ada
type T1 is record
...
- end record with Destructor => Foo;
+ end record;
- procedure Foo (X : in out T1);
+ procedure T1'Destructor (X : in out T1);
type T2 is new T1;
- overriding
- procedure Foo (X : in out T2); -- Error here
+ procedure T2'Destructor (X : in out T2);
-It is possible to specify ``Destructor`` on the completion of a private type,
-but there is one more restriction in that case: the denoted primitive must
-be private to the enclosing package. This is necessary due to the previously
-mentioned legality rule, to prevent breaking the privacy of the type when
-imposing that rule on outside types that derive from the private view of the
-type.
+When an object of type :ada:`T2` is finalized, there will be first a call to
+:ada:`T2'Destructor`, and then a call to :ada:`T1'Destructor` on the object.
Structural Generic Instantiation
--------------------------------
-- incomplete type, and the full type is available, then this full type
-- is returned instead of the incomplete type.
+-- Destructor
+-- Defined in all types and subtypes entities. For record type entities
+-- that have destructors (in the strict sense, i.e., have destructors of
+-- their own and do not just descend from types with destructors), set to
+-- the procedure entity for the destructor. For other entities, set to
+-- Empty.
+
-- DIC_Procedure (synthesized)
-- Defined in all type entities. Set for a private type and its full view
-- when the type is subject to pragma Default_Initial_Condition (DIC), or
-- Defined in all entities. True if the entity is type System.Address,
-- or (recursively) a subtype or derived type of System.Address.
--- Is_Destructor
--- Defined in procedure entities. True if the procedure is denoted by the
--- Destructor aspect on some type.
-
-- Is_DIC_Procedure
-- Defined in functions and procedures. Set for a generated procedure
-- which verifies the assumption of pragma Default_Initial_Condition at
-- Is_Constructor
-- Is_CPP_Constructor
-- Is_CUDA_Kernel
- -- Is_Destructor (non-generic case only)
-- Is_DIC_Procedure (non-generic case only)
-- Is_Elaboration_Checks_OK_Id
-- Is_Elaboration_Warnings_OK_Id
| Attribute_Definite
| Attribute_Delta
| Attribute_Denorm
+ | Attribute_Destructor
| Attribute_Digits
| Attribute_Emax
| Attribute_Enabled
end;
declare
- ASN : constant Opt_N_Aspect_Specification_Id :=
- Get_Rep_Item (Typ, Name_Destructor, False);
-
+ Proc : constant Entity_Id := Destructor (Typ);
Stmt : Node_Id;
- Proc : Entity_Id;
begin
- if Present (ASN) then
+ if Present (Proc) then
-- Generate:
-- begin
-- <Destructor_Proc> (V);
-- end if;
-- end;
- Proc := Entity (Expression (ASN));
Stmt :=
Make_Procedure_Call_Statement
(Loc,
end if;
Inherit_Aspects_At_Freeze_Point (E);
-
- -- Destructor legality check
-
- if Present (Primitive_Operations (E)) then
- declare
- Subp : Entity_Id;
- Parent_Operation : Entity_Id;
-
- Elmt : Elmt_Id := First_Elmt (Primitive_Operations (E));
-
- begin
- while Present (Elmt) loop
- Subp := Node (Elmt);
-
- if Present (Overridden_Operation (Subp)) then
- Parent_Operation := Overridden_Operation (Subp);
-
- if Ekind (Parent_Operation) = E_Procedure
- and then Is_Destructor (Parent_Operation)
- then
- Error_Msg_N ("cannot override destructor", Subp);
- end if;
- end if;
-
- Next_Elmt (Elmt);
- end loop;
- end;
- end if;
-
end if;
-- Case of array type
Digits_Value,
Predicated_Parent,
Predicates_Ignored,
+ Destructor,
Direct_Primitive_Operations,
Directly_Designated_Type,
Disable_Controlled,
Is_CPP_Constructor,
Is_CUDA_Kernel,
Is_Descendant_Of_Address,
- Is_Destructor,
Is_DIC_Procedure,
Is_Discrim_SO_Function,
Is_Discriminant_Check_Function,
Sm (Contract, Node_Id),
Sm (Current_Use_Clause, Node_Id),
Sm (Derived_Type_Link, Node_Id),
+ Sm (Destructor, Node_Id),
Sm (Direct_Primitive_Operations, Elist_Id),
Sm (Predicates_Ignored, Flag),
Sm (Esize, Uint),
Sm (Is_Asynchronous, Flag),
Sm (Is_Called, Flag),
Sm (Is_CUDA_Kernel, Flag),
- Sm (Is_Destructor, Flag),
Sm (Is_DIC_Procedure, Flag),
Sm (Is_Generic_Actual_Subprogram, Flag),
Sm (Is_Initial_Condition_Procedure, Flag),
@copying
@quotation
-GNAT Reference Manual , Dec 05, 2025
+GNAT Reference Manual , Jan 09, 2026
AdaCore
@subsection Destructors
-The @code{Destructor} aspect can be applied to any record type, tagged or not.
-It must denote a primitive of the type that is a procedure with one parameter
-of the type and of mode @code{in out}:
+The @code{Destructor} extension adds a new finalization mechanism that
+significantly differs standard Ada in how it interacts with type derivation.
-@example
-type T is record
- ...
-end record with Destructor => Foo;
-
-procedure Foo (X : in out T);
-@end example
-
-This is equivalent to the following code that uses @code{Finalizable}:
+New syntax is introduced to make it possible to define “destructors” for record
+types, tagged or untagged. Here’s a simple example:
@example
-type T is record
- ...
-end record with Finalizable => (Finalize => Foo);
+package P is
+ type T is record
+ ...
+ end record;
-procedure Foo (X : in out T);
+ procedure T'Destructor (X : in out T);
+end P;
@end example
-Unlike @code{Finalizable}, however, @code{Destructor} can be specified on a derived
-type. And when it is, the effect of the aspect combines with the destructors of
-the parent type. Take, for example:
-
@example
-type T1 is record
- ...
-end record with Destructor => Foo;
-
-procedure Foo (X : in out T1);
-
-type T2 is new T1 with Destructor => Bar;
-
-procedure Bar (X : in out T2);
+package body P is
+ procedure T'Destructor (X : in out T) is
+ begin
+ ...
+ end T'Destructor;
+end P;
@end example
-Here, when an object of type @code{T2} is finalized, a call to @code{Bar}
-will be performed and it will be followed by a call to @code{Foo}.
+Like @code{Finalize} procedures, destructors are called on objects just before they
+are destroyed. But destructors are more flexible in how they can used with derived
+types. With standard Ada finalization, when you derive from a finalizable type,
+you must either inherit the @code{Finalize} procedure or override it completely.
-The @code{Destructor} aspect comes with a legality rule: if a primitive procedure
-of a type is denoted by a @code{Destructor} aspect specification, it is illegal to
-override this procedure in a derived type. For example, the following is illegal:
+Destructors work differently. You can define a destructor for a type derived from
+a parent type that also has a destructor, and then when objects of the derived type
+are finalized, both destructors will be called. For example:
@example
type T1 is record
...
-end record with Destructor => Foo;
+end record;
-procedure Foo (X : in out T1);
+procedure T1'Destructor (X : in out T1);
type T2 is new T1;
-overriding
-procedure Foo (X : in out T2); -- Error here
+procedure T2'Destructor (X : in out T2);
@end example
-It is possible to specify @code{Destructor} on the completion of a private type,
-but there is one more restriction in that case: the denoted primitive must
-be private to the enclosing package. This is necessary due to the previously
-mentioned legality rule, to prevent breaking the privacy of the type when
-imposing that rule on outside types that derive from the private view of the
-type.
+When an object of type @code{T2} is finalized, there will be first a call to
+@code{T2'Destructor}, and then a call to @code{T1'Destructor} on the object.
@node Structural Generic Instantiation,,Destructors,Experimental Language Extensions
@anchor{gnat_rm/gnat_language_extensions structural-generic-instantiation}@anchor{479}
@printindex ge
-@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{ }
@anchor{d2}@w{ }
+@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{ }
@c %**end of body
@bye
Set_Etype (N, Universal_Integer);
+ ----------------
+ -- Destructor --
+ ----------------
+
+ when Attribute_Destructor =>
+ Error_Attr_P ("attribute% can only be used to define destructors");
+
------------
-- Digits --
------------
| Attribute_Default_Bit_Order
| Attribute_Default_Scalar_Storage_Order
| Attribute_Deref
+ | Attribute_Destructor
| Attribute_Elaborated
| Attribute_Elab_Body
| Attribute_Elab_Spec
goto Continue;
end if;
- when Aspect_Destructor =>
- if not All_Extensions_Allowed then
- Error_Msg_Name_1 := Nam;
- Error_Msg_GNAT_Extension ("aspect %", Loc);
- goto Continue;
-
- elsif not Is_Type (E) then
- Error_Msg_N ("can only be specified for a type", Aspect);
- goto Continue;
- end if;
-
- Set_Has_Destructor (E);
- Set_Is_Controlled_Active (E);
-
when Aspect_Storage_Model_Type =>
if not All_Extensions_Allowed then
Error_Msg_Name_1 := Nam;
-- name, so we need to verify that one of these interpretations is
-- the one available at the freeze point.
- elsif A_Id in Aspect_Destructor
- | Aspect_Input
+ elsif A_Id in Aspect_Input
| Aspect_Output
| Aspect_Read
| Aspect_Write
Analyze (Expression (ASN));
return;
- when Aspect_Destructor =>
- if not Is_Record_Type (Entity (ASN)) then
- Error_Msg_N
- ("aspect Destructor can only be specified for a "
- & "record type",
- ASN);
- return;
- end if;
-
- Set_Has_Destructor (Entity (ASN));
- Set_Is_Controlled_Active (Entity (ASN));
-
- Analyze (Expression (ASN));
-
- if not Resolve_Finalization_Procedure
- (Expression (ASN), Entity (ASN))
- then
- Error_Msg_N
- ("destructor must be local procedure whose only formal "
- & "parameter has mode `IN OUT` and is of the type the "
- & "destructor is for",
- Expression (ASN));
- end if;
-
- Set_Is_Destructor (Entity (Expression (ASN)));
-
- declare
- Proc : constant Entity_Id := Entity (Expression (ASN));
- Overr : constant Opt_N_Entity_Id :=
- Overridden_Inherited_Operation (Proc);
- Orig : constant Entity_Id :=
- (if Present (Overr) then Overr else Proc);
-
- Decl : constant Node_Id :=
- Parent
- (if Nkind (Parent (Orig)) = N_Procedure_Specification
- then Parent (Orig)
- else Orig);
-
- Encl : constant Node_Id := Parent (Decl);
-
- Is_Private : constant Boolean :=
- Nkind (Encl) = N_Package_Specification
- and then Is_List_Member (Decl)
- and then List_Containing (Decl) = Private_Declarations (Encl);
-
- begin
-
- if Has_Private_Declaration (Entity (ASN))
- and then not Aspect_On_Partial_View (ASN)
- and then not Is_Private
- then
- Error_Msg_N
- ("aspect Destructor on full view cannot denote public "
- & "primitive",
- ASN);
- end if;
- end;
-
- return;
-
when Aspect_Storage_Model_Type =>
-- The aggregate argument of Storage_Model_Type is optional, and
-----------------------------------------
procedure Analyze_Direct_Attribute_Definition (Designator : Entity_Id) is
+ function Can_Be_Destructor_Of
+ (E : Entity_Id; T : Entity_Id) return Boolean;
+ -- Returns whether E can be declared the destructor of T
+
+ --------------------------
+ -- Can_Be_Destructor_Of --
+ --------------------------
+
+ function Can_Be_Destructor_Of
+ (E : Entity_Id; T : Entity_Id) return Boolean is
+ begin
+ return
+ Ekind (E) = E_Procedure
+ and then Scope (E) = Scope (T)
+ and then Present (First_Formal (E))
+ and then Ekind (First_Formal (E)) = E_In_Out_Parameter
+ and then Etype (First_Formal (E)) = T
+ and then No (Next_Formal (First_Formal (E)));
+ end Can_Be_Destructor_Of;
+
+ -- Local variables
+
Att_N : constant Node_Id := Original_Node (N);
Prefix_E : constant Entity_Id :=
Get_Name_Entity_Id (Chars (Prefix (Defining_Unit_Name (Att_N))));
Att_Name : constant Name_Id :=
Attribute_Name (Defining_Unit_Name (Att_N));
+
+ -- Start of processing for Analyze_Direct_Attribute_Definition
begin
pragma Assert (N /= Att_N);
("& must be defined before freezing#", Designator);
elsif Parent_Kind (Enclosing_Package_Or_Subprogram (Designator))
- /= N_Package_Specification
+ /= N_Package_Specification
then
Error_Msg_N
("& is required to be a primitive operation", Designator);
Set_Is_Constructor (Designator);
end if;
- when others =>
+ when Name_Destructor =>
+ if Parent_Kind (N) not in N_Subprogram_Declaration then
+ return;
+ elsif not Is_Record_Type (Prefix_E) then
+ Error_Msg_N
+ ("destructors can only be specified for record types",
+ Designator);
+ return;
+ elsif not Can_Be_Destructor_Of (Designator, Prefix_E) then
+ Error_Msg_N
+ ("destructor must be local procedure whose only formal "
+ & "parameter has mode `IN OUT` and is of the type the "
+ & "destructor is for",
+ Designator);
+ elsif Is_Frozen (Prefix_E)
+ or else Current_Scope /= Scope (Prefix_E)
+ then
+ Error_Msg_Sloc := Sloc (Freeze_Node (Prefix_E));
+ Error_Msg_N
+ ("& must be defined before freezing#", Designator);
+
+ elsif Parent_Kind (Enclosing_Package_Or_Subprogram (Designator))
+ /= N_Package_Specification
+ then
+ Error_Msg_N
+ ("& is required to be a primitive operation", Designator);
+
+ else
+ Set_Has_Destructor (Prefix_E);
+ Set_Is_Controlled_Active (Prefix_E);
+ Set_Destructor (Prefix_E, Designator);
+ end if;
+
+ when others =>
null;
end case;
function Is_Direct_Attribute_Definition_Name (N : Name_Id) return Boolean is
begin
- return Is_Attribute_Name (N) and then N = Name_Constructor;
+ return
+ Is_Attribute_Name (N) and then N in Name_Constructor | Name_Destructor;
end Is_Direct_Attribute_Definition_Name;
------------------------------
Name_Default_Value : constant Name_Id := N + $;
Name_Default_Component_Value : constant Name_Id := N + $;
Name_Designated_Storage_Model : constant Name_Id := N + $;
- Name_Destructor : constant Name_Id := N + $;
Name_Dimension : constant Name_Id := N + $;
Name_Dimension_System : constant Name_Id := N + $;
Name_Disable_Controlled : constant Name_Id := N + $;
Name_Denorm : constant Name_Id := N + $;
Name_Deref : constant Name_Id := N + $; -- GNAT
Name_Descriptor_Size : constant Name_Id := N + $;
+ Name_Destructor : constant Name_Id := N + $;
Name_Digits : constant Name_Id := N + $;
Name_Elaborated : constant Name_Id := N + $; -- GNAT
Name_Emax : constant Name_Id := N + $; -- Ada 83
Attribute_Denorm,
Attribute_Deref,
Attribute_Descriptor_Size,
+ Attribute_Destructor,
Attribute_Digits,
Attribute_Elaborated,
Attribute_Emax,
projects / thirdparty / gcc.git / commitdiff
