when Attribute_Make =>
declare
Constructor_Params : List_Id := New_Copy_List (Expressions (N));
- Constructor_Call : Node_Id;
- Constructor_EWA : Node_Id;
+ Constructor_Rhs : Node_Id;
Result_Decl : Node_Id;
Result_Id : constant Entity_Id :=
Make_Temporary (Loc, 'D', N);
Mutate_Ekind (Result_Id, E_Variable);
Set_Suppress_Initialization (Result_Id);
- -- Build a prefixed-notation call
+ -- A call to the copy constructor can be a special case. Even if
+ -- no copy constructor is declared (both explicitly by the user or
+ -- implicitly by the compiler), the call needs to succeed. In this
+ -- case, we rewrite the call simply as its unique actual.
- declare
- Proc_Name : constant Node_Id :=
- Make_Selected_Component (Loc,
- Prefix => New_Occurrence_Of (Result_Id, Loc),
- Selector_Name => Make_Identifier (Loc,
- Direct_Attribute_Definition_Name
- (Typ, Name_Constructor)));
- begin
- Set_Is_Prefixed_Call (Proc_Name);
-
- Constructor_Call := Make_Procedure_Call_Statement (Loc,
- Parameter_Associations => Constructor_Params,
- Name => Proc_Name);
- end;
+ if Is_Copy_Constructor_Call (N)
+ and then not Has_Copy_Constructor (Entity (Pref))
+ then
+ if Nkind (First (Exprs)) = N_Parameter_Association
+ then
+ Constructor_Rhs :=
+ Relocate_Node (Explicit_Actual_Parameter (First (Exprs)));
+ else
+ Constructor_Rhs := Relocate_Node (First (Exprs));
+ end if;
- Set_Is_Expanded_Constructor_Call (Constructor_Call, True);
+ -- Otherwise build a prefixed-notation call
- Constructor_EWA :=
- Make_Expression_With_Actions (Loc,
- Actions => New_List (Result_Decl, Constructor_Call),
- Expression => New_Occurrence_Of (Result_Id, Loc));
+ else
+ declare
+ Constructor_Name : constant Node_Id :=
+ Make_Selected_Component (Loc,
+ Prefix => New_Occurrence_Of (Result_Id, Loc),
+ Selector_Name => Make_Identifier (Loc,
+ Direct_Attribute_Definition_Name
+ (Typ, Name_Constructor)));
+ Constructor_Call : Node_Id;
+ begin
+ Set_Is_Prefixed_Call (Constructor_Name);
+ Constructor_Call :=
+ Make_Procedure_Call_Statement (Loc,
+ Parameter_Associations => Constructor_Params,
+ Name => Constructor_Name);
+ Set_Is_Expanded_Constructor_Call (Constructor_Call, True);
+
+ Constructor_Rhs :=
+ Make_Expression_With_Actions (Loc,
+ Actions => New_List (Result_Decl, Constructor_Call),
+ Expression => New_Occurrence_Of (Result_Id, Loc));
+ end;
+ end if;
- Rewrite (N, Constructor_EWA);
+ Rewrite (N, Constructor_Rhs);
end;
Analyze_And_Resolve (N, Typ);
-- used for attachment of any actions required in its construction.
-- It also supplies the source location used for the procedure.
+ procedure Build_Implicit_Copy_Constructor (N : Node_Id; Typ : Entity_Id);
+ -- Build default copy constructor. N is the type declaration node, and Typ
+ -- is the corresponding entity for the record type.
+
function Build_Discriminant_Formals
(Rec_Id : Entity_Id;
Use_Dl : Boolean) return List_Id;
end if;
end Build_Or_Copy_Discr_Checking_Funcs;
+ -------------------------------------
+ -- Build_Implicit_Copy_Constructor --
+ -------------------------------------
+
+ procedure Build_Implicit_Copy_Constructor (N : Node_Id; Typ : Entity_Id) is
+ Loc : constant Source_Ptr := Sloc (Typ);
+ Copy_Id : Entity_Id;
+
+ Comp_List, Comp_Decl : Node_Id;
+ Comp_Id, Comp_Typ : Entity_Id;
+
+ Body_Stmts, Parameters, Aspect_Specs : List_Id;
+ Spec_Node, Stmt : Node_Id;
+ Self, From : Entity_Id;
+ begin
+ -- Only build copy constructor for user-defined non-limited tagged
+ -- record types that needs construction without having declared a copy
+ -- constructor already, or without having it explicitly removed. This
+ -- implicit copy needs to call first the parent's copy constructor (if
+ -- derived), second to copy field-by-field the components, and third to
+ -- call their respective copy constructors if necessary.
+
+ if not Comes_From_Source (N)
+ or else Is_Limited_Type (Typ)
+ or else not Is_Tagged_Type (Typ)
+ or else not Needs_Construction (Typ)
+ or else Has_Copy_Constructor (Typ, Allow_Removed => True)
+ then
+ return;
+ end if;
+
+ if Is_Derived_Type (Typ) then
+ Comp_List :=
+ Component_List (Record_Extension_Part (Type_Definition (N)));
+ else
+ Comp_List := Component_List (Type_Definition (N));
+ end if;
+
+ -- Here, there is still a possibility that an implicit copy constructor
+ -- is actually not needed.
+
+ declare
+ Found : Boolean := False;
+ begin
+ if Present (Comp_List) then
+ Comp_Decl := First_Non_Pragma (Component_Items (Comp_List));
+ while not Found and then Present (Comp_Decl) loop
+ Comp_Id := Defining_Identifier (Comp_Decl);
+ Comp_Typ := Etype (Comp_Id);
+ if Has_Copy_Constructor (Comp_Typ) then
+ Found := True;
+ end if;
+ Next_Non_Pragma (Comp_Decl);
+ end loop;
+ end if;
+
+ -- If Found is false, then there is no component in the current type
+ -- with a copy constructor. If also the type is either not derived or
+ -- its parent has no copy constructor, then there is no need for a
+ -- copy constructor for the current type as its behavior would be
+ -- identical to the byte-wise copy provided by assignment.
+
+ if not Found
+ and then (if Is_Derived_Type (Typ)
+ then not Has_Copy_Constructor (Parent_Subtype (Typ)))
+ then
+ return;
+ end if;
+ end;
+
+ Copy_Id :=
+ Make_Defining_Identifier (Loc,
+ Direct_Attribute_Definition_Name (Typ, Name_Constructor));
+ Mutate_Ekind (Copy_Id, E_Procedure);
+
+ if not Debug_Generated_Code then
+ Set_Debug_Info_Off (Copy_Id);
+ end if;
+
+ -- The copy constructor has the following profile:
+ -- procedure T'Constructor (Self : in out T; From : T);
+
+ Self := Make_Defining_Identifier (Loc, Name_Self);
+ From := Make_Defining_Identifier (Loc, Name_From);
+
+ Parameters := New_List (
+ Make_Parameter_Specification (Loc,
+ Defining_Identifier => Self,
+ In_Present => True,
+ Out_Present => True,
+ Parameter_Type => New_Occurrence_Of (Typ, Loc)),
+ Make_Parameter_Specification (Loc,
+ Defining_Identifier => From,
+ In_Present => True,
+ Parameter_Type => New_Occurrence_Of (Typ, Loc)));
+
+ -- The first thing to do in the implicit copy constructor is to copy
+ -- components field-by-field, the parent copy constructor call is
+ -- prepended later via the 'Super aspect.
+
+ Body_Stmts := New_List;
+ if Present (Comp_List) then
+ Comp_Decl := First_Non_Pragma (Component_Items (Comp_List));
+ while Present (Comp_Decl) loop
+ Comp_Id := Defining_Identifier (Comp_Decl);
+ Comp_Typ := Etype (Comp_Id);
+
+ if Chars (Comp_Id) not in Name_uParent | Name_uTag then
+ Stmt :=
+ Make_Assignment_Statement (Loc,
+ Name =>
+ Make_Selected_Component (Loc,
+ Prefix => New_Occurrence_Of (Self, Loc),
+ Selector_Name => New_Occurrence_Of (Comp_Id, Loc)),
+ Expression =>
+ Make_Selected_Component (Loc,
+ Prefix => New_Occurrence_Of (From, Loc),
+ Selector_Name => New_Occurrence_Of (Comp_Id, Loc)));
+ Set_Assignment_OK (Name (Stmt));
+ Set_No_Ctrl_Actions (Stmt);
+ Append_To (Body_Stmts, Stmt);
+ end if;
+
+ Next_Non_Pragma (Comp_Decl);
+ end loop;
+
+ -- Then, call the copy constructor for each component that needs
+ -- construction and has a copy constructor.
+
+ Comp_Decl := First_Non_Pragma (Component_Items (Comp_List));
+ while Present (Comp_Decl) loop
+ Comp_Id := Defining_Identifier (Comp_Decl);
+ Comp_Typ := Etype (Comp_Id);
+
+ -- For each component that has a copy constructor, generate:
+ -- Self.Comp_Id := Comp_Typ'Make (From.Comp_Id);
+
+ if Chars (Comp_Id) /= Name_uParent
+ and then Needs_Construction (Comp_Typ)
+ and then Has_Copy_Constructor (Comp_Typ)
+ then
+ Stmt :=
+ Make_Assignment_Statement (Loc,
+ Name =>
+ Make_Selected_Component (Loc,
+ Prefix => New_Occurrence_Of (Self, Loc),
+ Selector_Name => New_Occurrence_Of (Comp_Id, Loc)),
+ Expression =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Comp_Typ, Loc),
+ Attribute_Name => Name_Make,
+ Expressions => New_List (
+ Make_Selected_Component (Loc,
+ Prefix => New_Occurrence_Of (From, Loc),
+ Selector_Name =>
+ New_Occurrence_Of (Comp_Id, Loc)))));
+ Set_Assignment_OK (Name (Stmt));
+ Append_To (Body_Stmts, Stmt);
+ end if;
+
+ -- Components that do not need construction or lack a copy
+ -- constructor are simply skipped since the expansion of a
+ -- constructor also takes care of default copies/initializations.
+
+ Next_Non_Pragma (Comp_Decl);
+ end loop;
+ end if;
+
+ -- Prepend the call to the parent's copy constructor if derived
+
+ if Is_Derived_Type (Typ)
+ and then Has_Copy_Constructor (Parent_Subtype (Typ))
+ then
+ Aspect_Specs := New_List
+ (Make_Aspect_Specification (Loc,
+ Identifier => Make_Identifier (Loc, Name_Super),
+ Expression =>
+ Make_Aggregate (Loc,
+ Expressions => New_List (
+ Make_Type_Conversion (Loc,
+ Subtype_Mark =>
+ New_Occurrence_Of (Parent_Subtype (Typ), Loc),
+ Expression => New_Occurrence_Of (From, Loc))),
+ Is_Parenthesis_Aggregate => True,
+ Is_Homogeneous_Aggregate => True)));
+ else
+ Aspect_Specs := No_List;
+ end if;
+
+ Spec_Node := New_Node (N_Procedure_Specification, Loc);
+ Set_Defining_Unit_Name (Spec_Node, Copy_Id);
+ Set_Parameter_Specifications (Spec_Node, Parameters);
+ Freeze_Extra_Formals (Copy_Id);
+
+ declare
+ Ignore : Node_Id;
+ begin
+ Ignore :=
+ Make_Subprogram_Body (Loc,
+ Specification => Spec_Node,
+ Aspect_Specifications => Aspect_Specs,
+ Handled_Statement_Sequence =>
+ Make_Handled_Sequence_Of_Statements (Loc, Body_Stmts));
+ end;
+
+ Set_Is_Public (Copy_Id, Is_Public (Typ));
+ Set_Is_Internal (Copy_Id);
+ Set_Is_Constructor (Copy_Id);
+ Set_Init_Proc (Typ, Copy_Id);
+ end Build_Implicit_Copy_Constructor;
+
--------------------------------
-- Build_Discriminant_Formals --
--------------------------------
and then (Tagged_Type_Expansion or else not Is_Interface (Typ))
then
Build_Record_Init_Proc (Typ_Decl, Typ);
+ Build_Implicit_Copy_Constructor (Typ_Decl, Typ);
end if;
-- Create the body of TSS primitive Finalize_Address. This must be done
return;
end if;
- -- Expand objects with default constructors to have the 'Make
- -- attribute.
+ -- Expand objects to use constructors if needed
if Comes_From_Source (N)
- and then No (Expr)
and then Needs_Construction (Typ)
- and then Has_Default_Constructor (Typ)
+
+ -- Don't expand copy constructor for objects initialized with aggregates
+
+ and then (if Present (Expr)
+ then Nkind (Expr) not in N_Aggregate
+ | N_Delta_Aggregate
+ | N_Extension_Aggregate)
+
+ -- Don't expand copy constructor if a constructor was explicitly called
+
+ and then (if Present (Expr)
+ then (Nkind (Original_Node (Expr)) /= N_Attribute_Reference
+ or else Attribute_Name (Original_Node (Expr))
+ /= Name_Make))
then
- Expr := Make_Attribute_Reference (Loc,
- Attribute_Name => Name_Make,
- Prefix => Object_Definition (N));
+ if No (Expr) then
+ Expr :=
+ Make_Attribute_Reference
+ (Loc,
+ Attribute_Name => Name_Make,
+ Prefix => New_Occurrence_Of (Typ, Loc));
+ else
+ Expr :=
+ Make_Attribute_Reference
+ (Loc,
+ Attribute_Name => Name_Make,
+ Prefix => New_Occurrence_Of (Typ, Loc),
+ Expressions => New_List (Expr));
+ end if;
Set_Expression (N, Expr);
Analyze_And_Resolve (Expr);
end if;
end;
end if;
- -- Build a prefixed-notation call
- declare
- Proc_Name : constant Node_Id :=
- Make_Selected_Component (Loc,
- Prefix =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of
- (First_Formal (Spec_Id), Loc),
- Attribute_Name => Name_Super),
- Selector_Name =>
- Make_Identifier (Loc,
- Direct_Attribute_Definition_Name
- (Parent_Type, Name_Constructor)));
- begin
- Set_Is_Prefixed_Call (Proc_Name);
-
- return Make_Procedure_Call_Statement (Loc,
- Name => Proc_Name,
- Parameter_Associations => Actual_Parameters);
- end;
+ return Make_Assignment_Statement (Loc,
+ Name =>
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Occurrence_Of (First_Formal (Spec_Id), Loc),
+ Attribute_Name => Name_Super),
+ Expression =>
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Occurrence_Of (Parent_Type, Loc),
+ Attribute_Name => Name_Make,
+ Expressions => Actual_Parameters));
end Make_Parent_Constructor_Call;
begin
if Chars (Component) = Name_uTag then
null;
- elsif Chars (Component) = Name_uParent then
- -- ??? Here is where we should be looking for a
- -- Super aspect specification in order to call the
- -- right constructor with the right parameters
- -- (as opposed to unconditionally calling the
- -- single-parameter constructor).
+ elsif Chars (Component) = Name_uParent
+ and then Needs_Construction (Etype (Component))
+ then
Append_To (Init_List, Make_Parent_Constructor_Call
(Parent_Type => Etype (Component)));
Check_Type;
Set_Etype (N, Etype (P));
- if not Needs_Construction (Entity (P)) then
- Error_Msg_NE ("no available constructor for&", N, Entity (P));
- end if;
-
- if Present (Expressions (N)) then
- Expr := First (Expressions (N));
+ if Present (Exprs) then
+ Expr := First (Exprs);
while Present (Expr) loop
if Nkind (Expr) = N_Parameter_Association then
Analyze (Explicit_Actual_Parameter (Expr));
Next (Expr);
end loop;
+ if not Is_Copy_Constructor_Call (N)
+ and then not Needs_Construction (Entity (P))
+ then
+ Error_Msg_NE ("no available constructor for&", N, Entity (P));
+ end if;
+
elsif not Has_Default_Constructor (Entity (P)) then
Error_Msg_NE ("no default constructor for&", N, Entity (P));
end if;
goto Continue;
end if;
- if Ekind (E) /= E_Subprogram_Body
- or else Nkind (Parent (E)) /= N_Procedure_Specification
- then
+ if Nkind (N) /= N_Subprogram_Body then
Error_Msg_N ("Super must apply to a constructor body", N);
end if;
-- We retrieve the candidate operations from the generic declaration.
function Extended_Primitive_Ops (T : Entity_Id) return Elist_Id;
- -- Prefix notation can also be used on operations that are not
- -- primitives of the type, but are declared in the same immediate
+ -- Prefix notation can also be used on either constructors, which are
+ -- never primitives; or operations declared in the same immediate
-- declarative part, which can only mean the corresponding package
-- body (see RM 4.1.3 (9.2/3)). If we are in that body we extend the
-- list of primitives with body operations with the same name that
function Extended_Primitive_Ops (T : Entity_Id) return Elist_Id is
Type_Scope : constant Entity_Id := Scope (T);
Op_List : Elist_Id := Primitive_Operations (T);
+ Op_Found : Boolean := False;
begin
+ if Needs_Construction (T) then
+ -- to include all constructors iterate over T's entities
+
+ declare
+ Cursor : Entity_Id := Next_Entity (T);
+ begin
+ while Present (Cursor) loop
+ if Is_Constructor (Cursor) then
+ if not Op_Found then
+ -- Copy list of primitives so it is not affected
+ -- for other uses.
+
+ Op_List := New_Copy_Elist (Op_List);
+ Op_Found := True;
+ end if;
+ Append_Elmt (Cursor, Op_List);
+ end if;
+ Next_Entity (Cursor);
+ end loop;
+ end;
+ end if;
+
if Is_Package_Or_Generic_Package (Type_Scope)
and then ((In_Package_Body (Type_Scope)
and then In_Open_Scopes (Type_Scope)) or else In_Instance_Body)
declare
Body_Decls : constant List_Id :=
Declarations (Unit_Declaration_Node (The_Body));
- Op_Found : Boolean := False;
Op : Entity_Id := Current_Entity (Subprog);
begin
while Present (Op) loop
begin
Is_Primitive := False;
- if not Comes_From_Source (S) then
+ -- Constructors are never primitive operations
+
+ if Is_Constructor (S) then
+ null;
+
+ elsif not Comes_From_Source (S) then
if Present (Derived_Type) then
-- Add an inherited primitive for an untagged derived type to
-- Has_Default_Constructor --
-----------------------------
- function Has_Default_Constructor (Typ : Entity_Id) return Boolean is
- Cursor : Entity_Id;
- begin
- pragma Assert (Is_Type (Typ));
- if not Needs_Construction (Typ) then
- return False;
- end if;
-
- -- Iterate through all homonyms to find the default constructor
-
- Cursor := Get_Name_Entity_Id
- (Direct_Attribute_Definition_Name (Typ, Name_Constructor));
- while Present (Cursor) loop
- if Is_Constructor (Cursor)
- and then No (Next_Formal (First_Formal (Cursor)))
- then
- return True;
- end if;
-
- Cursor := Homonym (Cursor);
- end loop;
+ function Has_Default_Constructor
+ (Typ : Entity_Id; Allow_Removed : Boolean := False) return Boolean
+ is
+ function No_Next_Formal (N : Entity_Id) return Boolean
+ is (No (Next_Formal (First_Formal (N))));
- return False;
+ function Internal_Has_Default_Constructor
+ is new Has_Matching_Constructor (No_Next_Formal);
+ begin
+ return Internal_Has_Default_Constructor (Typ, Allow_Removed);
end Has_Default_Constructor;
-------------------
end if;
end Has_Enabled_Property;
+ --------------------------
+ -- Has_Copy_Constructor --
+ --------------------------
+
+ function Has_Copy_Constructor
+ (Typ : Entity_Id; Allow_Removed : Boolean := False) return Boolean
+ is
+ function Internal_Has_Copy_Constructor
+ is new Has_Matching_Constructor (Is_Copy_Constructor);
+ begin
+ return Internal_Has_Copy_Constructor (Typ, Allow_Removed);
+ end Has_Copy_Constructor;
+
-------------------------------------
-- Has_Full_Default_Initialization --
-------------------------------------
Present (Get_Pragma (Id, Pragma_Max_Entry_Queue_Length)));
end Has_Max_Queue_Length;
+ ------------------------------
+ -- Has_Matching_Constructor --
+ ------------------------------
+
+ function Has_Matching_Constructor
+ (Typ : Entity_Id; Allow_Removed : Boolean) return Boolean
+ is
+ Cursor : Entity_Id;
+ begin
+ pragma Assert (Is_Type (Typ));
+ if not Needs_Construction (Typ) then
+ return False;
+ end if;
+
+ -- Iterate through all constructors to find at least one constructor
+ -- that matches the given condition.
+
+ Cursor :=
+ Get_Name_Entity_Id
+ (Direct_Attribute_Definition_Name (Typ, Name_Constructor));
+ while Present (Cursor) loop
+ if (if not Allow_Removed then not Is_Abstract_Subprogram (Cursor))
+ and then Is_Constructor (Cursor)
+ and then Condition (Cursor)
+ then
+ return True;
+ end if;
+
+ Cursor := Homonym (Cursor);
+ end loop;
+
+ return False;
+ end Has_Matching_Constructor;
+
---------------------------------
-- Has_No_Obvious_Side_Effects --
---------------------------------
and then not Is_Record_Aggregate;
end Is_Container_Aggregate;
+ -------------------------
+ -- Is_Copy_Constructor --
+ -------------------------
+
+ function Is_Copy_Constructor (Spec_Id : Entity_Id) return Boolean is
+ begin
+ if Is_Constructor (Spec_Id)
+ and then Present (Next_Formal (First_Formal (Spec_Id)))
+ and then Etype (Next_Formal (First_Formal (Spec_Id)))
+ = Etype (First_Formal (Spec_Id))
+ and then Ekind (Next_Formal (First_Formal (Spec_Id)))
+ = E_In_Parameter
+ then
+ -- More formals with default values are allowed afterwards
+
+ declare
+ All_Defaults : Boolean := True;
+ Formal : Entity_Id :=
+ Next_Formal (Next_Formal (First_Formal (Spec_Id)));
+ begin
+ while Present (Formal) loop
+ if No (Default_Value (Formal)) then
+ All_Defaults := False;
+ exit;
+ end if;
+ Next_Formal (Formal);
+ end loop;
+
+ if All_Defaults then
+ return True;
+ end if;
+ end;
+ end if;
+
+ return False;
+ end Is_Copy_Constructor;
+
+ ------------------------------
+ -- Is_Copy_Constructor_Call --
+ ------------------------------
+
+ function Is_Copy_Constructor_Call (N : Node_Id) return Boolean is
+ begin
+ if Nkind (N) = N_Attribute_Reference
+ and then Is_Type (Entity (Prefix (N)))
+ and then Get_Attribute_Id (Attribute_Name (N)) = Attribute_Make
+ and then Present (Expressions (N))
+ and then Present (First (Expressions (N)))
+ and then No (Next (First (Expressions (N))))
+ then
+ -- If the actual is a parameter association, the selector name must
+ -- be "From" and its type must be an ancestor of the underlying one.
+
+ if Nkind (First (Expressions (N))) = N_Parameter_Association then
+ return Chars (Selector_Name (First (Expressions (N)))) = Name_From
+ and then Is_Ancestor
+ (Etype (Entity (Prefix (N))),
+ Etype (Explicit_Actual_Parameter
+ (First (Expressions (N)))));
+
+ -- The actual must be an ancestor of the underlying type to be used
+ -- in a copy constructor call.
+
+ else
+ return Is_Ancestor
+ (Etype (Entity (Prefix (N))),
+ Etype (First (Expressions (N))));
+
+ end if;
+ else
+ return False;
+ end if;
+ end Is_Copy_Constructor_Call;
+
-----------------------------
-- Is_Extended_Access_Type --
-----------------------------
function Is_Suitable_Primitive (Subp_Id : Entity_Id) return Boolean is
begin
- -- The Default_Initial_Condition and invariant procedures must not be
- -- treated as primitive operations even when they apply to a tagged
- -- type. These routines must not act as targets of dispatching calls
- -- because they already utilize class-wide-precondition semantics to
- -- handle inheritance and overriding.
+ -- The Default_Initial_Condition, invariant, and constructor procedures
+ -- must not be treated as primitive operations even when they apply to a
+ -- tagged type. These routines must not act as targets of dispatching
+ -- calls because they already utilize class-wide-precondition semantics
+ -- to handle inheritance and overriding.
if Ekind (Subp_Id) = E_Procedure
and then (Is_DIC_Procedure (Subp_Id)
or else
- Is_Invariant_Procedure (Subp_Id))
+ Is_Invariant_Procedure (Subp_Id)
+ or else
+ Is_Constructor (Subp_Id))
then
return False;
end if;
function Has_Defaulted_Discriminants (Typ : Entity_Id) return Boolean;
-- Simple predicate to test for defaulted discriminants
- function Has_Default_Constructor (Typ : Entity_Id) return Boolean;
+ function Has_Default_Constructor
+ (Typ : Entity_Id; Allow_Removed : Boolean := False) return Boolean;
-- Determine whether Typ has a constructor with only one formal parameter.
+ -- If Allow_Removed is true, then also abstract constructors are considered
+ -- valid during the search.
function Has_Denormals (E : Entity_Id) return Boolean;
-- Determines if the floating-point type E supports denormal numbers.
-- parameter for reading or returns an effectively volatile value for
-- reading.
+ function Has_Copy_Constructor
+ (Typ : Entity_Id; Allow_Removed : Boolean := False) return Boolean;
+ -- Return True if a copy constructor has been explicitly declared by the
+ -- user, or the implicit copy constructor has been generated by the
+ -- compiler. If Allow_Removed is true, then also abstract constructors are
+ -- considered valid during the search.
+
function Has_Full_Default_Initialization (Typ : Entity_Id) return Boolean;
-- Determine whether type Typ defines "full default initialization" as
-- specified by SPARK RM 3.1. To qualify as such, the type must be
-- Determine whether Id is subject to pragma Max_Queue_Length. It is
-- assumed that Id denotes an entry.
+ generic
+ with function Condition (E : Entity_Id) return Boolean;
+ function Has_Matching_Constructor
+ (Typ : Entity_Id; Allow_Removed : Boolean) return Boolean;
+ -- Determine whether Typ has a constructor whose profile matches the
+ -- condition specified by the generic Condition function. If
+ -- Allow_Removed is True, constructors that have been removed by marking
+ -- them abstract are considered as well in the search.
+
function Has_No_Obvious_Side_Effects (N : Node_Id) return Boolean;
-- This is a simple minded function for determining whether an expression
-- has no obvious side effects. It is used only for determining whether
function Is_Container_Aggregate (Exp : Node_Id) return Boolean;
-- Is the given expression a container aggregate?
+ function Is_Copy_Constructor (Spec_Id : Entity_Id) return Boolean;
+ -- Return True if the specification Spec_Id denotes a copy constructor: a
+ -- constructor procedure with two formal parameters of the underlying type,
+ -- where the first formal is 'in out', and the second is 'in'. Many
+ -- additional defaulted parameters are permitted.
+
+ function Is_Copy_Constructor_Call (N : Node_Id) return Boolean;
+ -- Return True if N is a 'Make attribute reference with a single actual
+ -- parameter of the same type. Optionally, the only actual could be a
+ -- parameter association named "From".
+
function Is_Extended_Access_Type (Ent : Entity_Id) return Boolean;
-- Ent is any entity. Returns True if Ent is a type (or a subtype thereof)
-- for which the Extended_Access aspect has been specified, either
Name_Exception_Raised : constant Name_Id := N + $;
Name_External_Name : constant Name_Id := N + $;
Name_Form : constant Name_Id := N + $;
+ Name_From : constant Name_Id := N + $;
Name_Gcc : constant Name_Id := N + $;
Name_General : constant Name_Id := N + $;
Name_Gnat : constant Name_Id := N + $;
Name_Runtime : constant Name_Id := N + $;
Name_SB : constant Name_Id := N + $;
Name_Section : constant Name_Id := N + $;
+ Name_Self : constant Name_Id := N + $;
Name_Semaphore : constant Name_Id := N + $;
Name_Simple_Barriers : constant Name_Id := N + $;
Name_SPARK : constant Name_Id := N + $;
projects / thirdparty / gcc.git / commitdiff
