-- have a 'Last/'First reference in which case the value returned is the
-- appropriate type bound.
+ function Is_Known_Valid_Operand (Opnd : Node_Id) return Boolean;
+ -- Even if the context does not assume that values are valid, some
+ -- simple cases can be recognized.
+
function Is_Same_Value (L, R : Node_Id) return Boolean;
-- Returns True iff L and R represent expressions that definitely
-- have identical (but not necessarily compile time known) values
else -- Attribute_Name (N) = Name_Last
return Make_Integer_Literal (Sloc (N),
Intval => Intval (String_Literal_Low_Bound (Xtyp))
- + String_Literal_Length (Xtyp));
+ + String_Literal_Length (Xtyp));
end if;
end if;
return N;
end Compare_Fixup;
+ ----------------------------
+ -- Is_Known_Valid_Operand --
+ ----------------------------
+
+ function Is_Known_Valid_Operand (Opnd : Node_Id) return Boolean is
+ begin
+ return (Is_Entity_Name (Opnd)
+ and then
+ (Is_Known_Valid (Entity (Opnd))
+ or else Ekind (Entity (Opnd)) = E_In_Parameter
+ or else
+ (Ekind (Entity (Opnd)) in Object_Kind
+ and then Present (Current_Value (Entity (Opnd))))))
+ or else Is_OK_Static_Expression (Opnd);
+ end Is_Known_Valid_Operand;
+
-------------------
-- Is_Same_Value --
-------------------
Rf : constant Node_Id := Compare_Fixup (R);
function Is_Same_Subscript (L, R : List_Id) return Boolean;
- -- L, R are the Expressions values from two attribute nodes
- -- for First or Last attributes. Either may be set to No_List
- -- if no expressions are present (indicating subscript 1).
- -- The result is True if both expressions represent the same
- -- subscript (note that one case is where one subscript is
- -- missing and the other is explicitly set to 1).
+ -- L, R are the Expressions values from two attribute nodes for First
+ -- or Last attributes. Either may be set to No_List if no expressions
+ -- are present (indicating subscript 1). The result is True if both
+ -- expressions represent the same subscript (note one case is where
+ -- one subscript is missing and the other is explicitly set to 1).
-----------------------
-- Is_Same_Subscript --
return Unknown;
-- For access types, the only time we know the result at compile time
- -- (apart from identical operands, which we handled already, is if we
+ -- (apart from identical operands, which we handled already) is if we
-- know one operand is null and the other is not, or both operands are
-- known null.
return Unknown;
end if;
- elsif Known_Non_Null (L)
- and then Known_Null (R)
- then
+ elsif Known_Non_Null (L) and then Known_Null (R) then
return NE;
else
-- For remaining scalar cases we know exactly (note that this does
-- include the fixed-point case, where we know the run time integer
- -- values now)
+ -- values now).
else
declare
and then RLo = RHi
and then LLo = RLo
then
- return EQ;
+
+ -- If the range includes a single literal and we can assume
+ -- validity then the result is known even if an operand is
+ -- not static.
+
+ if Assume_Valid then
+ return EQ;
+ else
+ return Unknown;
+ end if;
elsif LHi = RLo then
return LE;
elsif RHi = LLo then
return GE;
+
+ elsif not Is_Known_Valid_Operand (L)
+ and then not Assume_Valid
+ then
+ if Is_Same_Value (L, R) then
+ return EQ;
+ else
+ return Unknown;
+ end if;
end if;
end if;
end;
Atyp := Designated_Type (Atyp);
end if;
- -- If we have an array type (we should have but perhaps there
- -- are error cases where this is not the case), then see if we
- -- can do a constant evaluation of the array reference.
+ -- If we have an array type (we should have but perhaps there are
+ -- error cases where this is not the case), then see if we can do
+ -- a constant evaluation of the array reference.
- if Is_Array_Type (Atyp) then
+ if Is_Array_Type (Atyp) and then Atyp /= Any_Composite then
if Ekind (Atyp) = E_String_Literal_Subtype then
Lbd := String_Literal_Low_Bound (Atyp);
else
-- Numeric literals are static (RM 4.9(1)), and have already been marked
-- as static by the analyzer. The reason we did it that early is to allow
-- the possibility of turning off the Is_Static_Expression flag after
- -- analysis, but before resolution, when integer literals are generated
- -- in the expander that do not correspond to static expressions.
+ -- analysis, but before resolution, when integer literals are generated in
+ -- the expander that do not correspond to static expressions.
procedure Eval_Integer_Literal (N : Node_Id) is
T : constant Entity_Id := Etype (N);
function In_Any_Integer_Context return Boolean;
- -- If the literal is resolved with a specific type in a context
- -- where the expected type is Any_Integer, there are no range checks
- -- on the literal. By the time the literal is evaluated, it carries
- -- the type imposed by the enclosing expression, and we must recover
- -- the context to determine that Any_Integer is meant.
+ -- If the literal is resolved with a specific type in a context where
+ -- the expected type is Any_Integer, there are no range checks on the
+ -- literal. By the time the literal is evaluated, it carries the type
+ -- imposed by the enclosing expression, and we must recover the context
+ -- to determine that Any_Integer is meant.
----------------------------
- -- To_Any_Integer_Context --
+ -- In_Any_Integer_Context --
----------------------------
function In_Any_Integer_Context return Boolean is
begin
-- Any_Integer also appears in digits specifications for real types,
- -- but those have bounds smaller that those of any integer base
- -- type, so we can safely ignore these cases.
+ -- but those have bounds smaller that those of any integer base type,
+ -- so we can safely ignore these cases.
return K = N_Number_Declaration
or else K = N_Attribute_Reference
begin
-- If the literal appears in a non-expression context, then it is
- -- certainly appearing in a non-static context, so check it. This
- -- is actually a redundant check, since Check_Non_Static_Context
- -- would check it, but it seems worth while avoiding the call.
+ -- certainly appearing in a non-static context, so check it. This is
+ -- actually a redundant check, since Check_Non_Static_Context would
+ -- check it, but it seems worth while avoiding the call.
if Nkind (Parent (N)) not in N_Subexpr
and then not In_Any_Integer_Context
-- Eval_Membership_Op --
------------------------
- -- A membership test is potentially static if the expression is static,
- -- and the range is a potentially static range, or is a subtype mark
- -- denoting a static subtype (RM 4.9(12)).
+ -- A membership test is potentially static if the expression is static, and
+ -- the range is a potentially static range, or is a subtype mark denoting a
+ -- static subtype (RM 4.9(12)).
procedure Eval_Membership_Op (N : Node_Id) is
Left : constant Node_Id := Left_Opnd (N);
Fold : Boolean;
begin
- -- Ignore if error in either operand, except to make sure that
- -- Any_Type is properly propagated to avoid junk cascaded errors.
+ -- Ignore if error in either operand, except to make sure that Any_Type
+ -- is properly propagated to avoid junk cascaded errors.
if Etype (Left) = Any_Type
or else Etype (Right) = Any_Type
return;
end if;
- -- For string membership tests we will check the length
- -- further below.
+ -- For string membership tests we will check the length further on
if not Is_String_Type (Def_Id) then
Lo := Type_Low_Bound (Def_Id);
end;
end if;
- -- Fold the membership test. We know we have a static range and Lo
- -- and Hi are set to the expressions for the end points of this range.
+ -- Fold the membership test. We know we have a static range and Lo and
+ -- Hi are set to the expressions for the end points of this range.
elsif Is_Real_Type (Etype (Right)) then
declare
Typ : constant Entity_Id := Etype (N);
begin
- -- Negation is equivalent to subtracting from the modulus minus
- -- one. For a binary modulus this is equivalent to the ones-
- -- component of the original value. For non-binary modulus this
- -- is an arbitrary but consistent definition.
+ -- Negation is equivalent to subtracting from the modulus minus one.
+ -- For a binary modulus this is equivalent to the ones-complement of
+ -- the original value. For non-binary modulus this is an arbitrary
+ -- but consistent definition.
if Is_Modular_Integer_Type (Typ) then
Fold_Uint (N, Modulus (Typ) - 1 - Rint, Stat);
Hex : Boolean;
begin
- -- Can only fold if target is string or scalar and subtype is static
+ -- Can only fold if target is string or scalar and subtype is static.
-- Also, do not fold if our parent is an allocator (this is because
-- the qualified expression is really part of the syntactic structure
-- of an allocator, and we do not want to end up with something that
then
Check_Non_Static_Context (Operand);
- -- If operand is known to raise constraint_error, set the
- -- flag on the expression so it does not get optimized away.
+ -- If operand is known to raise constraint_error, set the flag on the
+ -- expression so it does not get optimized away.
if Nkind (Operand) = N_Raise_Constraint_Error then
Set_Raises_Constraint_Error (N);
PK : constant Node_Kind := Nkind (Parent (N));
begin
- -- If the literal appears in a non-expression context
- -- and not as part of a number declaration, then it is
- -- appearing in a non-static context, so check it.
+ -- If the literal appears in a non-expression context and not as part of
+ -- a number declaration, then it is appearing in a non-static context,
+ -- so check it.
if PK not in N_Subexpr and then PK /= N_Number_Declaration then
Check_Non_Static_Context (N);
Length_Mismatch : declare
procedure Get_Static_Length (Op : Node_Id; Len : out Uint);
- -- If Op is an expression for a constrained array with a known
- -- at compile time length, then Len is set to this (non-negative
+ -- If Op is an expression for a constrained array with a known at
+ -- compile time length, then Len is set to this (non-negative
-- length). Otherwise Len is set to minus 1.
-----------------------
Left_Int := Expr_Value (Left);
if (Kind = N_And_Then and then Is_False (Left_Int))
- or else (Kind = N_Or_Else and Is_True (Left_Int))
+ or else
+ (Kind = N_Or_Else and then Is_True (Left_Int))
then
Fold_Uint (N, Left_Int, Rstat);
return;
elsif not Is_Scalar_Type (T1) or else not Is_Scalar_Type (T1) then
return False;
+ -- If T1 has infinities but T2 doesn't have infinities, then T1 is
+ -- definitely not compatible with T2.
+
+ elsif Is_Floating_Point_Type (T1)
+ and then Has_Infinities (T1)
+ and then Is_Floating_Point_Type (T2)
+ and then not Has_Infinities (T2)
+ then
+ return False;
+
else
L1 := Type_Low_Bound (T1);
H1 := Type_High_Bound (T1);
"(RM 4.9(5))!", N, E);
end if;
- when N_Binary_Op | N_And_Then | N_Or_Else | N_Membership_Test =>
+ when N_Binary_Op | N_Short_Circuit | N_Membership_Test =>
if Nkind (N) in N_Op_Shift then
Error_Msg_N
("shift functions are never static (RM 4.9(6,18))!", N);
if Attribute_Name (N) = Name_Size then
Error_Msg_N
- ("size attribute is only static for scalar type " &
+ ("size attribute is only static for static scalar type " &
"(RM 4.9(7,8))", N);
-- Flag array cases
OSDN Git Service
