-- because the selected component may be a reference to the
-- object being initialized, whose discriminant is not yet
-- set. This only happens in complex cases involving changes
- -- or representation.
+ -- of representation.
if Disc = Entity (Selector_Name (N))
and then (Is_Entity_Name (Dval)
-- constrained by an outer discriminant, which cannot
-- be optimized away.
- if Denotes_Discriminant
- (Dval, Check_Concurrent => True)
- then
- exit Discr_Loop;
-
- elsif Nkind (Original_Node (Dval)) = N_Selected_Component
- and then
- Denotes_Discriminant
- (Selector_Name (Original_Node (Dval)), True)
+ if Denotes_Discriminant (Dval, Check_Concurrent => True)
then
exit Discr_Loop;
CI : constant List_Id := Component_Items (CL);
VP : constant Node_Id := Variant_Part (CL);
- Alts : List_Id;
- DC : Node_Id;
- DCH : List_Id;
- Expr : Node_Id;
- Result : List_Id;
- V : Node_Id;
+ Constrained_Typ : Entity_Id;
+ Alts : List_Id;
+ DC : Node_Id;
+ DCH : List_Id;
+ Expr : Node_Id;
+ Result : List_Id;
+ V : Node_Id;
begin
+ -- Try to find a constrained type to extract discriminant values
+ -- from, so that the case statement built below gets an
+ -- opportunity to be folded by Expand_N_Case_Statement.
+
+ if U_U or else Is_Constrained (Etype (Rhs)) then
+ Constrained_Typ := Etype (Rhs);
+ elsif Is_Constrained (Etype (Expression (N))) then
+ Constrained_Typ := Etype (Expression (N));
+ else
+ Constrained_Typ := Empty;
+ end if;
+
Result := Make_Field_Assigns (CI);
if Present (VP) then
Next_Non_Pragma (V);
end loop;
- -- If we have an Unchecked_Union, use the value of the inferred
- -- discriminant of the variant part expression as the switch
- -- for the case statement. The case statement may later be
- -- folded.
-
- if U_U then
+ if Present (Constrained_Typ) then
Expr :=
New_Copy (Get_Discriminant_Value (
Entity (Name (VP)),
- Etype (Rhs),
- Discriminant_Constraint (Etype (Rhs))));
+ Constrained_Typ,
+ Discriminant_Constraint (Constrained_Typ)));
else
Expr :=
Make_Selected_Component (Loc,
-- Start of processing for Expand_Assign_Record
begin
- -- Note that we use the base types for this processing. This results
- -- in some extra work in the constrained case, but the change of
- -- representation case is so unusual that it is not worth the effort.
+ -- Note that we need to use the base types for this processing in
+ -- order to retrieve the Type_Definition. In the constrained case,
+ -- we filter out the non relevant fields in
+ -- Make_Component_List_Assign.
-- First copy the discriminants. This is done unconditionally. It
-- is required in the unconstrained left side case, and also in the
CF := F;
end if;
- if Is_Unchecked_Union (Base_Type (R_Typ)) then
+ if Is_Unchecked_Union (R_Typ) then
-- Within an initialization procedure this is the
-- assignment to an unchecked union component, in which
Insert_Actions (N,
Make_Component_List_Assign (Component_List (RDef), True));
else
- Insert_Actions
- (N, Make_Component_List_Assign (Component_List (RDef)));
+ Insert_Actions (N,
+ Make_Component_List_Assign (Component_List (RDef)));
end if;
Rewrite (N, Make_Null_Statement (Loc));
New_Id : Entity_Id;
begin
+ -- If Discrete_Subtype_Definition has been rewritten as an
+ -- N_Raise_xxx_Error, rewrite the whole loop as a raise node to
+ -- avoid confusing the code generator down the line.
+
+ if Nkind (Discrete_Subtype_Definition (LPS)) in N_Raise_xxx_Error
+ then
+ Rewrite (N, Discrete_Subtype_Definition (LPS));
+ return;
+ end if;
+
if Present (Iterator_Filter (LPS)) then
pragma Assert (Ada_Version >= Ada_2020);
Set_Statements (N,
procedure Analyze_Attribute (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Aname : constant Name_Id := Attribute_Name (N);
- P : constant Node_Id := Prefix (N);
Exprs : constant List_Id := Expressions (N);
Attr_Id : constant Attribute_Id := Get_Attribute_Id (Aname);
+ P_Old : constant Node_Id := Prefix (N);
+
+ P : Node_Id := P_Old;
E1 : Node_Id;
E2 : Node_Id;
-- Case of an expression
- Resolve (P);
+ Resolve (P_Old);
if Is_Access_Type (P_Type) then
Freeze_Before (N, Designated_Type (P_Type));
end if;
- Rewrite (P,
- Make_Explicit_Dereference (Sloc (P),
- Prefix => Relocate_Node (P)));
+ Rewrite (P_Old,
+ Make_Explicit_Dereference (Sloc (P_Old),
+ Prefix => Relocate_Node (P_Old)));
- Analyze_And_Resolve (P);
- P_Type := Etype (P);
+ Analyze_And_Resolve (P_Old);
+ P_Type := Etype (P_Old);
if P_Type = Any_Type then
raise Bad_Attribute;
end if;
end if;
+ -- If the prefix was rewritten as a raise node, then rewrite N as a
+ -- raise node, to avoid creating inconsistent trees. We still need to
+ -- perform legality checks on the original tree.
+
+ if Nkind (P) in N_Raise_xxx_Error then
+ Rewrite (N, Relocate_Node (P));
+ P := Original_Node (P_Old);
+ end if;
+
-- Remaining processing depends on attribute
case Attr_Id is
Comp_List : constant Elist_Id := New_Elmt_List;
Parent_Type : constant Entity_Id := Etype (Typ);
Assoc_List : constant List_Id := New_List;
- Discr_Val : Elmt_Id;
- Errors : Boolean;
- New_C : Entity_Id;
- Old_C : Entity_Id;
- Is_Static : Boolean := True;
+
+ Discr_Val : Elmt_Id;
+ Errors : Boolean;
+ New_C : Entity_Id;
+ Old_C : Entity_Id;
+ Is_Static : Boolean := True;
+ Is_Compile_Time_Known : Boolean := True;
procedure Collect_Fixed_Components (Typ : Entity_Id);
-- Collect parent type components that do not appear in a variant part
while Present (Discr_Val) loop
if not Is_OK_Static_Expression (Node (Discr_Val)) then
Is_Static := False;
- exit;
+
+ if not Compile_Time_Known_Value (Node (Discr_Val)) then
+ Is_Compile_Time_Known := False;
+ exit;
+ end if;
end if;
Next_Elmt (Discr_Val);
end if;
end Add_Discriminants;
- if Is_Static
+ if Is_Compile_Time_Known
and then Is_Variant_Record (Typ)
then
Collect_Fixed_Components (Typ);
-
- Gather_Components (
- Typ,
- Component_List (Type_Definition (Parent (Typ))),
- Governed_By => Assoc_List,
- Into => Comp_List,
- Report_Errors => Errors);
- pragma Assert (not Errors
- or else Serious_Errors_Detected > 0);
+ Gather_Components
+ (Typ,
+ Component_List (Type_Definition (Parent (Typ))),
+ Governed_By => Assoc_List,
+ Into => Comp_List,
+ Report_Errors => Errors,
+ Allow_Compile_Time => True);
+ pragma Assert (not Errors or else Serious_Errors_Detected > 0);
Create_All_Components;
-- with constraints, we retrieve the record definition of the parent
-- type to select the components of the proper variant.
- elsif Is_Static
+ elsif Is_Compile_Time_Known
and then Is_Tagged_Type (Typ)
and then Nkind (Parent (Typ)) = N_Full_Type_Declaration
and then
and then Is_Variant_Record (Parent_Type)
then
Collect_Fixed_Components (Typ);
-
Gather_Components
(Typ,
Component_List (Type_Definition (Parent (Parent_Type))),
- Governed_By => Assoc_List,
- Into => Comp_List,
- Report_Errors => Errors);
+ Governed_By => Assoc_List,
+ Into => Comp_List,
+ Report_Errors => Errors,
+ Allow_Compile_Time => True);
-- Note: previously there was a check at this point that no errors
-- were detected. As a consequence of AI05-220 there may be an error
-- static constraint.
-- If the tagged derivation has a type extension, collect all the
- -- new components therein.
+ -- new relevant components therein via Gather_Components.
if Present (Record_Extension_Part (Type_Definition (Parent (Typ))))
then
- Old_C := First_Component (Typ);
- while Present (Old_C) loop
- if Original_Record_Component (Old_C) = Old_C
- and then Chars (Old_C) /= Name_uTag
- and then Chars (Old_C) /= Name_uParent
- then
- Append_Elmt (Old_C, Comp_List);
- end if;
-
- Next_Component (Old_C);
- end loop;
+ Gather_Components
+ (Typ,
+ Component_List
+ (Record_Extension_Part (Type_Definition (Parent (Typ)))),
+ Governed_By => Assoc_List,
+ Into => Comp_List,
+ Report_Errors => Errors,
+ Allow_Compile_Time => True,
+ Include_Interface_Tag => True);
end if;
Create_All_Components;
Apply_Compile_Time_Constraint_Error
(N, "component not present in }??",
CE_Discriminant_Check_Failed,
- Ent => Prefix_Type, Rep => False);
+ Ent => Prefix_Type);
Set_Raises_Constraint_Error (N);
return;
Check_Predicate_Use (Entity (Subtype_Mark (DS)));
end if;
- Make_Index (DS, N);
+ if Nkind (DS) not in N_Raise_xxx_Error then
+ Make_Index (DS, N);
+ end if;
+
Set_Ekind (Id, E_Loop_Parameter);
-- A quantified expression which appears in a pre- or post-condition may
-- Obtain the name of the object from node Nod which is being renamed by
-- the object renaming declaration N.
+ function Find_Raise_Node (N : Node_Id) return Traverse_Result;
+ -- Process one node in search for N_Raise_xxx_Error nodes.
+ -- Return Abandon if found, OK otherwise.
+
+ ---------------------
+ -- Find_Raise_Node --
+ ---------------------
+
+ function Find_Raise_Node (N : Node_Id) return Traverse_Result is
+ begin
+ if Nkind (N) in N_Raise_xxx_Error then
+ return Abandon;
+ else
+ return OK;
+ end if;
+ end Find_Raise_Node;
+
+ ------------------------
+ -- No_Raise_xxx_Error --
+ ------------------------
+
+ function No_Raise_xxx_Error is new Traverse_Func (Find_Raise_Node);
+ -- Traverse tree to look for a N_Raise_xxx_Error node and returns
+ -- Abandon if so and OK if none found.
+
------------------------------
-- Check_Constrained_Object --
------------------------------
then
Error_Msg_N ("incompatible types in renaming", Nam);
- -- AI12-0383: Names that denote values can be renamed
+ -- AI12-0383: Names that denote values can be renamed.
+ -- Ignore (accept) N_Raise_xxx_Error nodes in this context.
- elsif Ada_Version < Ada_2020 then
+ elsif Ada_Version < Ada_2020
+ and then No_Raise_xxx_Error (Nam) = OK
+ then
Error_Msg_N ("value in renaming requires -gnat2020", Nam);
end if;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
+with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Elab; use Sem_Elab;
N_Character_Literal | N_Real_Literal | N_String_Literal | N_Null
then
return True;
+
+ -- Evaluate static discriminants, to eliminate dead paths and
+ -- redundant discriminant checks.
+
+ elsif Is_Static_Discriminant_Component (Op) then
+ return True;
end if;
end if;
Warn_On_Known_Condition (N);
end Eval_Relational_Op;
+ -----------------------------
+ -- Eval_Selected_Component --
+ -----------------------------
+
+ procedure Eval_Selected_Component (N : Node_Id) is
+ begin
+ -- If an attribute reference or a LHS, nothing to do.
+ -- Also do not fold if N is an [in] out subprogram parameter.
+ -- Fold will perform the other relevant tests.
+
+ if Nkind (Parent (N)) /= N_Attribute_Reference
+ and then Is_LHS (N) = No
+ and then not Is_Actual_Out_Or_In_Out_Parameter (N)
+ then
+ Fold (N);
+ end if;
+ end Eval_Selected_Component;
+
----------------
-- Eval_Shift --
----------------
elsif Kind = N_Unchecked_Type_Conversion then
return Expr_Rep_Value (Expression (N));
+ -- Static discriminant value
+
+ elsif Is_Static_Discriminant_Component (N) then
+ return Expr_Rep_Value
+ (Get_Discriminant_Value
+ (Entity (Selector_Name (N)),
+ Etype (Prefix (N)),
+ Discriminant_Constraint (Etype (Prefix (N)))));
+
else
raise Program_Error;
end if;
elsif Kind = N_Unchecked_Type_Conversion then
Val := Expr_Value (Expression (N));
+ -- Static discriminant value
+
+ elsif Is_Static_Discriminant_Component (N) then
+ Val := Expr_Value
+ (Get_Discriminant_Value
+ (Entity (Selector_Name (N)),
+ Etype (Prefix (N)),
+ Discriminant_Constraint (Etype (Prefix (N)))));
+
else
raise Program_Error;
end if;
end if;
end Flag_Non_Static_Expr;
+ ----------
+ -- Fold --
+ ----------
+
+ procedure Fold (N : Node_Id) is
+ Typ : constant Entity_Id := Etype (N);
+ begin
+ -- If not known at compile time or if already a literal, nothing to do
+
+ if Nkind (N) in N_Numeric_Or_String_Literal
+ or else not Compile_Time_Known_Value (N)
+ then
+ null;
+
+ elsif Is_Discrete_Type (Typ) then
+ Fold_Uint (N, Expr_Value (N), Static => Is_Static_Expression (N));
+
+ elsif Is_Real_Type (Typ) then
+ Fold_Ureal (N, Expr_Value_R (N), Static => Is_Static_Expression (N));
+
+ elsif Is_String_Type (Typ) then
+ Fold_Str
+ (N, Strval (Expr_Value_S (N)), Static => Is_Static_Expression (N));
+ end if;
+ end Fold;
+
----------------
-- Fold_Dummy --
----------------
procedure Eval_Op_Not (N : Node_Id);
procedure Eval_Real_Literal (N : Node_Id);
procedure Eval_Relational_Op (N : Node_Id);
+ procedure Eval_Selected_Component (N : Node_Id);
procedure Eval_Shift (N : Node_Id);
procedure Eval_Short_Circuit (N : Node_Id);
procedure Eval_Slice (N : Node_Id);
-- The call has no effect if Raises_Constraint_Error (N) is True, since
-- there is no point in folding if we have an error.
+ procedure Fold (N : Node_Id);
+ -- Rewrite N with the relevant value if Compile_Time_Known_Value (N) is
+ -- True, otherwise a no-op.
+
function Is_In_Range
(N : Node_Id;
Typ : Entity_Id;
Set_Etype (N, Base_Type (Typ));
end if;
- -- Note: No Eval processing is required, because the prefix is of a
- -- record type, or protected type, and neither can possibly be static.
+ -- Eval_Selected_Component may e.g. fold statically known discriminants.
- -- If the record type is atomic and the component is not, then this is
- -- worth a warning before Ada 2020, since we have a situation where the
- -- access to the component may cause extra read/writes of the atomic
- -- object, or partial word accesses, both of which may be unexpected.
+ Eval_Selected_Component (N);
- if Nkind (N) = N_Selected_Component
- and then Is_Atomic_Ref_With_Address (N)
- and then not Is_Atomic (Entity (S))
- and then not Is_Atomic (Etype (Entity (S)))
- and then Ada_Version < Ada_2020
- then
- Error_Msg_N
- ("??access to non-atomic component of atomic record",
- Prefix (N));
- Error_Msg_N
- ("\??may cause unexpected accesses to atomic object",
- Prefix (N));
- end if;
+ if Nkind (N) = N_Selected_Component then
- Resolve_Implicit_Dereference (Prefix (N));
- Analyze_Dimension (N);
+ -- If the record type is atomic and the component is not, then this
+ -- is worth a warning before Ada 2020, since we have a situation
+ -- where the access to the component may cause extra read/writes of
+ -- the atomic object, or partial word accesses, both of which may be
+ -- unexpected.
+
+ if Is_Atomic_Ref_With_Address (N)
+ and then not Is_Atomic (Entity (S))
+ and then not Is_Atomic (Etype (Entity (S)))
+ and then Ada_Version < Ada_2020
+ then
+ Error_Msg_N
+ ("??access to non-atomic component of atomic record",
+ Prefix (N));
+ Error_Msg_N
+ ("\??may cause unexpected accesses to atomic object",
+ Prefix (N));
+ end if;
+
+ Resolve_Implicit_Dereference (Prefix (N));
+ Analyze_Dimension (N);
+ end if;
end Resolve_Selected_Component;
-------------------
-----------------------
procedure Gather_Components
- (Typ : Entity_Id;
- Comp_List : Node_Id;
- Governed_By : List_Id;
- Into : Elist_Id;
- Report_Errors : out Boolean)
+ (Typ : Entity_Id;
+ Comp_List : Node_Id;
+ Governed_By : List_Id;
+ Into : Elist_Id;
+ Report_Errors : out Boolean;
+ Allow_Compile_Time : Boolean := False;
+ Include_Interface_Tag : Boolean := False)
is
Assoc : Node_Id;
Variant : Node_Id;
while Present (Comp_Item) loop
- -- Skip the tag of a tagged record, the interface tags, as well
- -- as all items that are not user components (anonymous types,
- -- rep clauses, Parent field, controller field).
+ -- Skip the tag of a tagged record, as well as all items that are not
+ -- user components (anonymous types, rep clauses, Parent field,
+ -- controller field).
if Nkind (Comp_Item) = N_Component_Declaration then
declare
Comp : constant Entity_Id := Defining_Identifier (Comp_Item);
begin
- if not Is_Tag (Comp) and then Chars (Comp) /= Name_uParent then
+ if not (Is_Tag (Comp)
+ and then not
+ (Include_Interface_Tag
+ and then Etype (Comp) = RTE (RE_Interface_Tag)))
+ and then Chars (Comp) /= Name_uParent
+ then
Append_Elmt (Comp, Into);
end if;
end;
end loop Find_Constraint;
Discrim_Value := Expression (Assoc);
- if Is_OK_Static_Expression (Discrim_Value) then
+
+ if Is_OK_Static_Expression (Discrim_Value)
+ or else (Allow_Compile_Time
+ and then Compile_Time_Known_Value (Discrim_Value))
+ then
Discrim_Value_Status := Static_Expr;
else
if Ada_Version >= Ada_2020 then
end if;
Gather_Components
- (Typ, Component_List (Variant), Governed_By, Into, Report_Errors);
+ (Typ, Component_List (Variant), Governed_By, Into,
+ Report_Errors, Allow_Compile_Time);
end if;
end Gather_Components;
and then Assertion_Expression_Pragma (Get_Pragma_Id (Prag));
end In_Assertion_Expression_Pragma;
+ -------------------
+ -- In_Check_Node --
+ -------------------
+
+ function In_Check_Node (N : Node_Id) return Boolean is
+ Node : Node_Id := Parent (N);
+ begin
+ while Present (Node) loop
+ if Nkind (Node) in N_Raise_xxx_Error then
+ return True;
+ end if;
+
+ Node := Parent (Node);
+ end loop;
+
+ return False;
+ end In_Check_Node;
+
-------------------------------
-- In_Generic_Formal_Package --
-------------------------------
return Present (Formal) and then Ekind (Formal) = E_In_Out_Parameter;
end Is_Actual_In_Out_Parameter;
+ ---------------------------------------
+ -- Is_Actual_Out_Or_In_Out_Parameter --
+ ---------------------------------------
+
+ function Is_Actual_Out_Or_In_Out_Parameter (N : Node_Id) return Boolean is
+ Formal : Entity_Id;
+ Call : Node_Id;
+ begin
+ Find_Actual (N, Formal, Call);
+ return Present (Formal)
+ and then Ekind (Formal) in E_Out_Parameter | E_In_Out_Parameter;
+ end Is_Actual_Out_Or_In_Out_Parameter;
+
-------------------------
-- Is_Actual_Parameter --
-------------------------
P_Aliased : Boolean := False;
Comp : Entity_Id;
- Deref : Node_Id := Object;
+ Deref : Node_Id := Original_Node (Object);
-- Dereference node, in something like X.all.Y(2)
-- Start of processing for Is_Dependent_Component_Of_Mutable_Object
while Nkind (Deref) in
N_Indexed_Component | N_Selected_Component | N_Slice
loop
- Deref := Prefix (Deref);
+ Deref := Original_Node (Prefix (Deref));
end loop;
- Deref := Original_Node (Deref);
-
-- If the prefix is a qualified expression of a variable, then function
-- Is_Variable will return False for that because a qualified expression
-- denotes a constant view, so we need to get the name being qualified
elsif Nkind (Object) = N_Indexed_Component
or else Nkind (Object) = N_Slice
then
- return Is_Dependent_Component_Of_Mutable_Object (Prefix (Object));
+ return Is_Dependent_Component_Of_Mutable_Object
+ (Original_Node (Prefix (Object)));
-- A type conversion that Is_Variable is a view conversion:
-- go back to the denoted object.
elsif Nkind (Object) = N_Type_Conversion then
return
- Is_Dependent_Component_Of_Mutable_Object (Expression (Object));
+ Is_Dependent_Component_Of_Mutable_Object
+ (Original_Node (Expression (Object)));
end if;
end if;
-------------------------
function Is_Object_Reference (N : Node_Id) return Boolean is
+ function Safe_Prefix (N : Node_Id) return Node_Id;
+ -- Return Prefix (N) unless it has been rewritten as an
+ -- N_Raise_xxx_Error node, in which case return its original node.
+
+ -----------------
+ -- Safe_Prefix --
+ -----------------
+
+ function Safe_Prefix (N : Node_Id) return Node_Id is
+ begin
+ if Nkind (Prefix (N)) in N_Raise_xxx_Error then
+ return Original_Node (Prefix (N));
+ else
+ return Prefix (N);
+ end if;
+ end Safe_Prefix;
+
begin
-- AI12-0068: Note that a current instance reference in a type or
-- subtype's aspect_specification is considered a value, not an object
| N_Slice
=>
return
- Is_Object_Reference (Prefix (N))
- or else Is_Access_Type (Etype (Prefix (N)));
+ Is_Object_Reference (Safe_Prefix (N))
+ or else Is_Access_Type (Etype (Safe_Prefix (N)));
-- In Ada 95, a function call is a constant object; a procedure
-- call is not.
return
Is_Object_Reference (Selector_Name (N))
and then
- (Is_Object_Reference (Prefix (N))
- or else Is_Access_Type (Etype (Prefix (N))));
+ (Is_Object_Reference (Safe_Prefix (N))
+ or else Is_Access_Type (Etype (Safe_Prefix (N))));
-- An explicit dereference denotes an object, except that a
-- conditional expression gets turned into an explicit dereference
or else Nkind (N) = N_Procedure_Call_Statement;
end Is_Statement;
+ --------------------------------------
+ -- Is_Static_Discriminant_Component --
+ --------------------------------------
+
+ function Is_Static_Discriminant_Component (N : Node_Id) return Boolean is
+ begin
+ return Nkind (N) = N_Selected_Component
+ and then not Is_In_Discriminant_Check (N)
+ and then Present (Etype (Prefix (N)))
+ and then Ekind (Etype (Prefix (N))) = E_Record_Subtype
+ and then Has_Static_Discriminants (Etype (Prefix (N)))
+ and then Present (Entity (Selector_Name (N)))
+ and then Ekind (Entity (Selector_Name (N))) = E_Discriminant
+ and then not In_Check_Node (N);
+ end Is_Static_Discriminant_Component;
+
------------------------
-- Is_Static_Function --
------------------------
-- be installed on the scope stack to prevent spurious visibility errors.
procedure Gather_Components
- (Typ : Entity_Id;
- Comp_List : Node_Id;
- Governed_By : List_Id;
- Into : Elist_Id;
- Report_Errors : out Boolean);
+ (Typ : Entity_Id;
+ Comp_List : Node_Id;
+ Governed_By : List_Id;
+ Into : Elist_Id;
+ Report_Errors : out Boolean;
+ Allow_Compile_Time : Boolean := False;
+ Include_Interface_Tag : Boolean := False);
-- The purpose of this procedure is to gather the valid components in a
-- record type according to the values of its discriminants, in order to
-- validate the components of a record aggregate.
-- Report_Errors is set to True if the values of the discriminants are
-- non-static.
--
+ -- Allow_Compile_Time if set to True, allows compile time known values in
+ -- Governed_By expressions in addition to static expressions.
+ --
+ -- Include_Interface_Tag if set to True, gather any interface tag
+ -- component, otherwise exclude them.
+ --
-- This procedure is also used when building a record subtype. If the
-- discriminant constraint of the subtype is static, the components of the
-- subtype are only those of the variants selected by the values of the
-- Returns True if node N appears within a pragma that acts as an assertion
-- expression. See Sem_Prag for the list of qualifying pragmas.
+ function In_Check_Node (N : Node_Id) return Boolean;
+ -- Return True if N is part of a N_Raise_xxx_Error node
+
function In_Generic_Formal_Package (E : Entity_Id) return Boolean;
-- Returns True if entity E is inside a generic formal package
function Is_Actual_Out_Parameter (N : Node_Id) return Boolean;
-- Determines if N is an actual parameter of out mode in a subprogram call
+ function Is_Actual_Out_Or_In_Out_Parameter (N : Node_Id) return Boolean;
+ -- Determines if N is an actual parameter of out or in out mode in a
+ -- subprogram call.
+
function Is_Actual_Parameter (N : Node_Id) return Boolean;
-- Determines if N is an actual parameter in a subprogram call
-- the N_Statement_Other_Than_Procedure_Call subtype from Sinfo).
-- Note that a label is *not* a statement, and will return False.
+ function Is_Static_Discriminant_Component (N : Node_Id) return Boolean;
+ -- Return True if N is guaranteed to a selected component containing a
+ -- statically known discriminant.
+ -- Note that this routine takes a conservative view and may return False
+ -- in some cases where N would match the criteria. In other words this
+ -- routine should be used to simplify or optimize the expanded code.
+
function Is_Static_Function (Subp : Entity_Id) return Boolean;
-- Determine whether subprogram Subp denotes a static function,
-- which is a function with the aspect Static with value True.
projects / gcc.git / commitdiff