with Einfo; use Einfo;
with Errout; use Errout;
with Expander; use Expander;
-with Exp_Disp; use Exp_Disp;
with Exp_Ch6; use Exp_Ch6;
with Exp_Ch7; use Exp_Ch7;
+with Exp_Disp; use Exp_Disp;
with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
with Freeze; use Freeze;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
-with Sem_Aux; use Sem_Aux;
with Sem_Aggr; use Sem_Aggr;
with Sem_Attr; use Sem_Attr;
+with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
-with Sem_Ch4; use Sem_Ch4;
with Sem_Ch3; use Sem_Ch3;
+with Sem_Ch4; use Sem_Ch4;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch13; use Sem_Ch13;
with Sem_Elim; use Sem_Elim;
with Sem_Eval; use Sem_Eval;
with Sem_Intr; use Sem_Intr;
-with Sem_Util; use Sem_Util;
-with Targparm; use Targparm;
+with Sem_Mech; use Sem_Mech;
with Sem_Type; use Sem_Type;
+with Sem_Util; use Sem_Util;
with Sem_Warn; use Sem_Warn;
with Sinfo; use Sinfo;
with Sinfo.CN; use Sinfo.CN;
with Stand; use Stand;
with Stringt; use Stringt;
with Style; use Style;
+with Targparm; use Targparm;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
with Urealp; use Urealp;
procedure Simplify_Type_Conversion (N : Node_Id);
-- Called after N has been resolved and evaluated, but before range checks
-- have been applied. Currently simplifies a combination of floating-point
- -- to integer conversion and Rounding or Truncation attribute.
+ -- to integer conversion and Rounding or Truncation attribute, and also the
+ -- conversion of an integer literal to a dynamic integer type.
function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id;
-- A universal_fixed expression in an universal context is unambiguous if
Set_Etype (N, Expr_Type);
-- AI05-0139-2: Expression is overloaded because type has
- -- implicit dereference. If type matches context, no implicit
- -- dereference is involved. If the expression is an entity,
- -- generate a reference to it, as this is not done for an
- -- overloaded construct during analysis.
+ -- implicit dereference. The context may be the one that
+ -- requires implicit dereferemce.
elsif Has_Implicit_Dereference (Expr_Type) then
Set_Etype (N, Expr_Type);
Set_Is_Overloaded (N, False);
- if Is_Entity_Name (N) then
+ -- If the expression is an entity, generate a reference
+ -- to it, as this is not done for an overloaded construct
+ -- during analysis.
+
+ if Is_Entity_Name (N)
+ and then Comes_From_Source (N)
+ then
Generate_Reference (Entity (N), N);
+
+ -- Examine access discriminants of entity type,
+ -- to check whether one of them yields the
+ -- expected type.
+
+ declare
+ Disc : Entity_Id :=
+ First_Discriminant (Etype (Entity (N)));
+
+ begin
+ while Present (Disc) loop
+ exit when Is_Access_Type (Etype (Disc))
+ and then Has_Implicit_Dereference (Disc)
+ and then Designated_Type (Etype (Disc)) = Typ;
+
+ Next_Discriminant (Disc);
+ end loop;
+
+ if Present (Disc) then
+ Build_Explicit_Dereference (N, Disc);
+ end if;
+ end;
end if;
exit Interp_Loop;
-- convert implicitly are allowed in membership tests).
if Ada_Version >= Ada_2012
- and then Ekind (Ctx_Type) = E_General_Access_Type
+ and then Ekind (Base_Type (Ctx_Type)) = E_General_Access_Type
and then Ekind (Etype (N)) = E_Anonymous_Access_Type
and then Nkind (Parent (N)) not in N_Membership_Test
then
begin
-- Nothing to do if no parameters, or original node is neither a
-- function call nor a procedure call statement (happens in the
- -- operator-transformed-to-function call case), or the call does
+ -- operator-transformed-to-function call case), or the call is to an
+ -- operator symbol (which is usually in infix form), or the call does
-- not come from source, or this warning is off.
if not Warn_On_Parameter_Order
or else No (Parameter_Associations (N))
or else Nkind (Original_Node (N)) not in N_Subprogram_Call
+ or else (Nkind (Name (N)) = N_Identifier
+ and then Present (Entity (Name (N)))
+ and then Nkind (Entity (Name (N))) =
+ N_Defining_Operator_Symbol)
or else not Comes_From_Source (N)
then
return;
DDT : constant Entity_Id :=
Directly_Designated_Type (Base_Type (Etype (F)));
- New_Itype : Entity_Id;
-
begin
+ -- Displace the pointer to the object to reference its
+ -- secondary dispatch table.
+
if Is_Class_Wide_Type (DDT)
and then Is_Interface (DDT)
then
- New_Itype := Create_Itype (E_Anonymous_Access_Type, A);
- Set_Etype (New_Itype, Etype (A));
- Set_Directly_Designated_Type
- (New_Itype, Directly_Designated_Type (Etype (A)));
- Set_Etype (A, New_Itype);
+ Rewrite (A, Convert_To (Etype (F), Relocate_Node (A)));
+ Analyze_And_Resolve (A, Etype (F),
+ Suppress => Access_Check);
end if;
-- Ada 2005, AI-162:If the actual is an allocator, the
end if;
end if;
- if Etype (A) = Any_Type then
+ if A_Typ = Any_Type then
Set_Etype (N, Any_Type);
return;
end if;
-- Apply required constraint checks
- -- Gigi looks at the check flag and uses the appropriate types.
- -- For now since one flag is used there is an optimization
- -- which might not be done in the IN OUT case since Gigi does
- -- not do any analysis. More thought required about this ???
-
- -- In fact is this comment obsolete??? doesn't the expander now
- -- generate all these tests anyway???
-
- if Is_Scalar_Type (Etype (A)) then
+ if Is_Scalar_Type (A_Typ) then
Apply_Scalar_Range_Check (A, F_Typ);
- elsif Is_Array_Type (Etype (A)) then
+ elsif Is_Array_Type (A_Typ) then
Apply_Length_Check (A, F_Typ);
elsif Is_Record_Type (F_Typ)
if Nkind (A) = N_Type_Conversion then
if Is_Scalar_Type (A_Typ) then
- Apply_Scalar_Range_Check
- (Expression (A), Etype (Expression (A)), A_Typ);
- -- In addition, the returned value of the parameter must
- -- satisfy the bounds of the object type (see comment
- -- below).
+ -- Special case here tailored to Exp_Ch6.Is_Legal_Copy,
+ -- which would prevent the check from being generated.
+ -- This is for Starlet only though, so long obsolete.
+
+ if Mechanism (F) = By_Reference
+ and then Is_Valued_Procedure (Nam)
+ then
+ null;
+ else
+ Apply_Scalar_Range_Check
+ (Expression (A), Etype (Expression (A)), A_Typ);
+ end if;
+
+ -- In addition the return value must meet the constraints
+ -- of the object type (see the comment below).
Apply_Scalar_Range_Check (A, A_Typ, F_Typ);
and then Ekind (F) = E_Out_Parameter
then
Apply_Length_Check (A, F_Typ);
+
else
Apply_Range_Check (A, A_Typ, F_Typ);
end if;
end if;
end if;
- -- Check bad case of atomic/volatile argument (RM C.6(12))
+ -- Check illegal cases of atomic/volatile actual (RM C.6(12,13))
- if Is_By_Reference_Type (Etype (F))
+ if (Is_By_Reference_Type (Etype (F)) or else Is_Aliased (F))
and then Comes_From_Source (N)
then
if Is_Atomic_Object (A)
and then not Is_Atomic (Etype (F))
then
Error_Msg_NE
- ("cannot pass atomic argument to non-atomic formal&",
+ ("cannot pass atomic object to nonatomic formal&",
A, F);
+ Error_Msg_N
+ ("\which is passed by reference (RM C.6(12))", A);
elsif Is_Volatile_Object (A)
and then not Is_Volatile (Etype (F))
then
Error_Msg_NE
- ("cannot pass volatile argument to non-volatile formal&",
+ ("cannot pass volatile object to nonvolatile formal&",
+ A, F);
+ Error_Msg_N
+ ("\which is passed by reference (RM C.6(12))", A);
+ end if;
+
+ if Ada_Version >= Ada_2020
+ and then Is_Subcomponent_Of_Atomic_Object (A)
+ and then not Is_Atomic_Object (A)
+ then
+ Error_Msg_N
+ ("cannot pass nonatomic subcomponent of atomic object",
+ A);
+ Error_Msg_NE
+ ("\to formal & which is passed by reference (RM C.6(13))",
A, F);
end if;
end if;
-- the cases of a constraint expression which is an access attribute or
-- an access discriminant.
+ procedure Check_Allocator_Discrim_Accessibility_Exprs
+ (Curr_Exp : Node_Id;
+ Alloc_Typ : Entity_Id);
+ -- Dispatch checks performed by Check_Allocator_Discrim_Accessibility
+ -- across all expressions within a given conditional expression.
+
function In_Dispatching_Context return Boolean;
-- If the allocator is an actual in a call, it is allowed to be class-
-- wide when the context is not because it is a controlling actual.
end if;
end Check_Allocator_Discrim_Accessibility;
+ -------------------------------------------------
+ -- Check_Allocator_Discrim_Accessibility_Exprs --
+ -------------------------------------------------
+
+ procedure Check_Allocator_Discrim_Accessibility_Exprs
+ (Curr_Exp : Node_Id;
+ Alloc_Typ : Entity_Id)
+ is
+ Alt : Node_Id;
+ Expr : Node_Id;
+ Disc_Exp : constant Node_Id := Original_Node (Curr_Exp);
+ begin
+ -- When conditional expressions are constant folded we know at
+ -- compile time which expression to check - so don't bother with
+ -- the rest of the cases.
+
+ if Nkind (Curr_Exp) = N_Attribute_Reference then
+ Check_Allocator_Discrim_Accessibility (Curr_Exp, Alloc_Typ);
+
+ -- Non-constant-folded if expressions
+
+ elsif Nkind (Disc_Exp) = N_If_Expression then
+ -- Check both expressions if they are still present in the face
+ -- of expansion.
+
+ Expr := Next (First (Expressions (Disc_Exp)));
+ if Present (Expr) then
+ Check_Allocator_Discrim_Accessibility_Exprs (Expr, Alloc_Typ);
+ Expr := Next (Expr);
+ if Present (Expr) then
+ Check_Allocator_Discrim_Accessibility_Exprs
+ (Expr, Alloc_Typ);
+ end if;
+ end if;
+
+ -- Non-constant-folded case expressions
+
+ elsif Nkind (Disc_Exp) = N_Case_Expression then
+ -- Check all alternatives
+
+ Alt := First (Alternatives (Disc_Exp));
+ while Present (Alt) loop
+ Check_Allocator_Discrim_Accessibility_Exprs
+ (Expression (Alt), Alloc_Typ);
+
+ Next (Alt);
+ end loop;
+
+ -- Base case, check the accessibility of the original node of the
+ -- expression.
+
+ else
+ Check_Allocator_Discrim_Accessibility (Disc_Exp, Alloc_Typ);
+ end if;
+ end Check_Allocator_Discrim_Accessibility_Exprs;
+
----------------------------
-- In_Dispatching_Context --
----------------------------
while Present (Discrim) and then Present (Disc_Exp) loop
if Ekind (Etype (Discrim)) = E_Anonymous_Access_Type then
- Check_Allocator_Discrim_Accessibility (Disc_Exp, Typ);
+ Check_Allocator_Discrim_Accessibility_Exprs
+ (Disc_Exp, Typ);
end if;
Next_Discriminant (Discrim);
while Present (Discrim) and then Present (Constr) loop
if Ekind (Etype (Discrim)) = E_Anonymous_Access_Type then
if Nkind (Constr) = N_Discriminant_Association then
- Disc_Exp := Original_Node (Expression (Constr));
+ Disc_Exp := Expression (Constr);
else
- Disc_Exp := Original_Node (Constr);
+ Disc_Exp := Constr;
end if;
- Check_Allocator_Discrim_Accessibility (Disc_Exp, Typ);
+ Check_Allocator_Discrim_Accessibility_Exprs
+ (Disc_Exp, Typ);
end if;
Next_Discriminant (Discrim);
-- A universal real conditional expression can appear in a fixed-type
-- context and must be resolved with that context to facilitate the
- -- code generation in the back end.
+ -- code generation in the back end. However, If the context is
+ -- Universal_fixed (i.e. as an operand of a multiplication/division
+ -- involving a fixed-point operand) the conditional expression must
+ -- resolve to a unique visible fixed_point type, normally Duration.
elsif Nkind_In (N, N_Case_Expression, N_If_Expression)
and then Etype (N) = Universal_Real
and then Is_Fixed_Point_Type (B_Typ)
then
- Resolve (N, B_Typ);
+ if B_Typ = Universal_Fixed then
+ Resolve (N, Unique_Fixed_Point_Type (N));
+
+ else
+ Resolve (N, B_Typ);
+ end if;
else
Resolve (N);
-- an expression function may appear when it is part of a default
-- expression in a call to an initialization procedure, and must be
-- frozen now, even if the body is inserted at a later point.
+ -- Otherwise, the call freezes the expression if expander is active,
+ -- for example as part of an object declaration.
if Is_Entity_Name (Subp)
and then not In_Spec_Expression
and then not Is_Expression_Function_Or_Completion (Current_Scope)
and then
(not Is_Expression_Function_Or_Completion (Entity (Subp))
- or else Scope (Entity (Subp)) = Current_Scope)
+ or else Expander_Active)
then
if Is_Expression_Function (Entity (Subp)) then
-- checkable, the case of calling an immediately containing
-- subprogram is easy to catch.
- Check_Restriction (No_Recursion, N);
+ if not Is_Ignored_Ghost_Entity (Nam) then
+ Check_Restriction (No_Recursion, N);
+ end if;
-- If the recursive call is to a parameterless subprogram,
-- then even if we can't statically detect infinite
then
null;
+ -- A return statement from an ignored Ghost function does not use the
+ -- secondary stack (or any other one).
+
elsif Expander_Active
and then Ekind_In (Nam, E_Function, E_Subprogram_Type)
and then Requires_Transient_Scope (Etype (Nam))
+ and then not Is_Ignored_Ghost_Entity (Nam)
then
Establish_Transient_Scope (N, Manage_Sec_Stack => True);
end if;
-- If this is a dispatching call, generate the appropriate reference,
- -- for better source navigation in GPS.
+ -- for better source navigation in GNAT Studio.
if Is_Overloadable (Nam)
and then Present (Controlling_Argument (N))
Build_Call_Marker (N);
+ Mark_Use_Clauses (Subp);
+
+ Warn_On_Overlapping_Actuals (Nam, N);
+
-- In GNATprove mode, expansion is disabled, but we want to inline some
-- subprograms to facilitate formal verification. Indirect calls through
-- a subprogram type or within a generic cannot be inlined. Inlining is
end if;
end if;
+ -- Cannot inline a call inside the definition of a record type,
+ -- typically inside the constraints of the type. Calls in
+ -- default expressions are also not inlined, but this is
+ -- filtered out above when testing In_Default_Expr.
+
+ elsif Is_Record_Type (Current_Scope) then
+ Cannot_Inline
+ ("cannot inline & (inside record type)?", N, Nam_UA);
+
-- With the one-pass inlining technique, a call cannot be
-- inlined if the corresponding body has not been seen yet.
("cannot inline & (in potentially unevaluated context)?",
N, Nam_UA);
+ -- Calls cannot be inlined inside the conditions of while
+ -- loops, as this would create complex actions inside
+ -- the condition, that are not handled by GNATprove.
+
+ elsif In_While_Loop_Condition (N) then
+ Cannot_Inline
+ ("cannot inline & (in while loop condition)?", N, Nam_UA);
+
-- Do not inline calls which would possibly lead to missing a
-- type conversion check on an input parameter.
end if;
end if;
end if;
-
- Mark_Use_Clauses (Subp);
-
- Warn_On_Overlapping_Actuals (Nam, N);
end Resolve_Call;
-----------------------------
Get_First_Interp (N, I, It);
-- If the equality is user-defined, the type of the operands
- -- matches that of the formals. For a predefined operqtor,
+ -- matches that of the formals. For a predefined operator,
-- it is the scope that matters, given that the predefined
-- equality has Any_Type formals. In either case the result
- -- type (most often Booleam) must match the context .
+ -- type (most often Boolean) must match the context. The scope
+ -- is either that of the type, if there is a generated equality
+ -- (when there is an equality for the component type), or else
+ -- Standard otherwise.
while Present (It.Typ) loop
if Etype (It.Nam) = Typ
and then
(Etype (First_Entity (It.Nam)) = Etype (L)
+ or else Scope (It.Nam) = Standard_Standard
or else Scope (It.Nam) = Scope (T))
then
Set_Entity (N, It.Nam);
declare
Opnd : constant Node_Id := Right_Opnd (N);
+ Op_Id : Entity_Id;
+
begin
if B_Typ = Standard_Boolean
and then Nkind_In (Opnd, N_Op_Eq, N_Op_Ne)
and then Is_Overloaded (Opnd)
then
Resolve_Equality_Op (Opnd, B_Typ);
+ Op_Id := Entity (Opnd);
- if Ekind (Entity (Opnd)) = E_Function then
- Rewrite_Operator_As_Call (Opnd, Entity (Opnd));
+ if Ekind (Op_Id) = E_Function
+ and then not Is_Intrinsic_Subprogram (Op_Id)
+ then
+ Rewrite_Operator_As_Call (Opnd, Op_Id);
end if;
if not Inside_A_Generic or else Is_Entity_Name (Opnd) then
pragma Assert (Found);
Resolve (P, It1.Typ);
+
+ -- In general the expected type is the type of the context, not the
+ -- type of the candidate selected component.
+
Set_Etype (N, Typ);
Set_Entity_With_Checks (S, Comp1);
if Ekind (Typ) = E_Anonymous_Access_Subprogram_Type then
Set_Etype (N, Etype (Comp1));
+
+ -- When the type of the component is an access to a class-wide type
+ -- the relevant type is that of the component (since in such case we
+ -- may need to generate implicit type conversions or dispatching
+ -- calls).
+
+ elsif Is_Access_Type (Typ)
+ and then not Is_Class_Wide_Type (Designated_Type (Typ))
+ and then Is_Class_Wide_Type (Designated_Type (Etype (Comp1)))
+ then
+ Set_Etype (N, Etype (Comp1));
end if;
else
if Is_Access_Type (Etype (P)) then
T := Designated_Type (Etype (P));
Check_Fully_Declared_Prefix (T, P);
+
else
T := Etype (P);
+
+ -- If the prefix is an entity it may have a deferred reference set
+ -- during analysis of the selected component. After resolution we
+ -- can transform it into a proper reference. This prevents spurious
+ -- warnings on useless assignments when the same selected component
+ -- is the actual for an out parameter in a subsequent call.
+
+ if Is_Entity_Name (P)
+ and then Has_Deferred_Reference (Entity (P))
+ then
+ if May_Be_Lvalue (N) then
+ Generate_Reference (Entity (P), P, 'm');
+ else
+ Generate_Reference (Entity (P), P, 'r');
+ end if;
+ end if;
end if;
-- Set flag for expander if discriminant check required on a component
Set_Etype (Expression (N), Opnd);
end if;
+ -- It seems that Non_Limited_View should also be applied for
+ -- Target when it has a limited view, but that leads to missing
+ -- error checks on interface conversions further below. ???
+
if Is_Access_Type (Opnd) then
Opnd := Designated_Type (Opnd);
+
+ -- If the type of the operand is a limited view, use nonlimited
+ -- view when available. If it is a class-wide type, recover the
+ -- class-wide type of the nonlimited view.
+
+ if From_Limited_With (Opnd)
+ and then Has_Non_Limited_View (Opnd)
+ then
+ Opnd := Non_Limited_View (Opnd);
+ end if;
end if;
if Is_Access_Type (Target_Typ) then
Target := Designated_Type (Target);
+
+ -- If the target type is a limited view, use nonlimited view
+ -- when available.
+
+ if From_Limited_With (Target)
+ and then Has_Non_Limited_View (Target)
+ then
+ Target := Non_Limited_View (Target);
+ end if;
end if;
if Opnd = Target then
-- Conversion from interface type
+ -- It seems that it would be better for the error checks below
+ -- to be performed as part of Validate_Conversion (and maybe some
+ -- of the error checks above could be moved as well?). ???
+
elsif Is_Interface (Opnd) then
-- Ada 2005 (AI-217): Handle entities from limited views
and then (Is_Fixed_Point_Type (Operand_Typ)
or else (not GNATprove_Mode
and then Is_Floating_Point_Type (Operand_Typ)))
+ and then not Range_Checks_Suppressed (Target_Typ)
+ and then not Range_Checks_Suppressed (Operand_Typ)
then
Set_Do_Range_Check (Operand);
end if;
-- If the lower bound is not static we create a range for the string
-- literal, using the index type and the known length of the literal.
- -- The index type is not necessarily Positive, so the upper bound is
- -- computed as T'Val (T'Pos (Low_Bound) + L - 1).
+ -- If the length is 1, then the upper bound is set to a mere copy of
+ -- the lower bound; or else, if the index type is a signed integer,
+ -- then the upper bound is computed as Low_Bound + L - 1; otherwise,
+ -- the upper bound is computed as T'Val (T'Pos (Low_Bound) + L - 1).
else
declare
- Index_List : constant List_Id := New_List;
- Index_Type : constant Entity_Id := Etype (First_Index (Typ));
- High_Bound : constant Node_Id :=
- Make_Attribute_Reference (Loc,
- Attribute_Name => Name_Val,
- Prefix =>
- New_Occurrence_Of (Index_Type, Loc),
- Expressions => New_List (
- Make_Op_Add (Loc,
- Left_Opnd =>
- Make_Attribute_Reference (Loc,
- Attribute_Name => Name_Pos,
- Prefix =>
- New_Occurrence_Of (Index_Type, Loc),
- Expressions =>
- New_List (New_Copy_Tree (Low_Bound))),
- Right_Opnd =>
- Make_Integer_Literal (Loc,
- String_Length (Strval (N)) - 1))));
-
+ Length : constant Nat := String_Length (Strval (N));
+ Index_List : constant List_Id := New_List;
+ Index_Type : constant Entity_Id := Etype (First_Index (Typ));
Array_Subtype : Entity_Id;
Drange : Node_Id;
+ High_Bound : Node_Id;
Index : Node_Id;
Index_Subtype : Entity_Id;
begin
+ if Length = 1 then
+ High_Bound := New_Copy_Tree (Low_Bound);
+
+ elsif Is_Signed_Integer_Type (Index_Type) then
+ High_Bound :=
+ Make_Op_Add (Loc,
+ Left_Opnd => New_Copy_Tree (Low_Bound),
+ Right_Opnd => Make_Integer_Literal (Loc, Length - 1));
+
+ else
+ High_Bound :=
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_Val,
+ Prefix =>
+ New_Occurrence_Of (Index_Type, Loc),
+ Expressions => New_List (
+ Make_Op_Add (Loc,
+ Left_Opnd =>
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_Pos,
+ Prefix =>
+ New_Occurrence_Of (Index_Type, Loc),
+ Expressions =>
+ New_List (New_Copy_Tree (Low_Bound))),
+ Right_Opnd =>
+ Make_Integer_Literal (Loc, Length - 1))));
+ end if;
+
if Is_Integer_Type (Index_Type) then
Set_String_Literal_Low_Bound
(Subtype_Id, Make_Integer_Literal (Loc, 1));
Attribute_Name => Name_First,
Prefix =>
New_Occurrence_Of (Base_Type (Index_Type), Loc)));
- Set_Etype (String_Literal_Low_Bound (Subtype_Id), Index_Type);
end if;
- Analyze_And_Resolve (String_Literal_Low_Bound (Subtype_Id));
+ Analyze_And_Resolve
+ (String_Literal_Low_Bound (Subtype_Id), Base_Type (Index_Type));
-- Build bona fide subtype for the string, and wrap it in an
-- unchecked conversion, because the back end expects the
-- ityp (x)
-- with the Float_Truncate flag set to False or True respectively,
- -- which is more efficient.
+ -- which is more efficient. We reuse Rounding for Machine_Rounding
+ -- as System.Fat_Gen, which is a permissible behavior.
if Is_Floating_Point_Type (Opnd_Typ)
and then
and then Conversion_OK (N)))
and then Nkind (Operand) = N_Attribute_Reference
and then Nam_In (Attribute_Name (Operand), Name_Rounding,
+ Name_Machine_Rounding,
Name_Truncation)
then
declare
Relocate_Node (First (Expressions (Operand))));
Set_Float_Truncate (N, Truncate);
end;
+
+ -- Special processing for the conversion of an integer literal to
+ -- a dynamic type: we first convert the literal to the root type
+ -- and then convert the result to the target type, the goal being
+ -- to avoid doing range checks in Universal_Integer type.
+
+ elsif Is_Integer_Type (Target_Typ)
+ and then not Is_Generic_Type (Root_Type (Target_Typ))
+ and then Nkind (Operand) = N_Integer_Literal
+ and then Opnd_Typ = Universal_Integer
+ then
+ Convert_To_And_Rewrite (Root_Type (Target_Typ), Operand);
+ Analyze_And_Resolve (Operand);
end if;
end;
end if;
if Ada_Version >= Ada_2012
and then not Comes_From_Source (N)
and then Is_Rewrite_Substitution (N)
- and then Ekind (Target_Type) = E_General_Access_Type
+ and then Ekind (Base_Type (Target_Type)) = E_General_Access_Type
and then Ekind (Opnd_Type) = E_Anonymous_Access_Type
then
if Is_Itype (Opnd_Type) then
git://gcc.gnu.org / gcc.git / blobdiff