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;
-- initialization of individual components within the init proc itself.
-- Could be optimized away perhaps?
+ procedure Check_No_Direct_Boolean_Operators (N : Node_Id);
+ -- N is the node for a logical operator. If the operator is predefined, and
+ -- the root type of the operands is Standard.Boolean, then a check is made
+ -- for restriction No_Direct_Boolean_Operators. This procedure also handles
+ -- the style check for Style_Check_Boolean_And_Or.
+
function Is_Definite_Access_Type (E : Entity_Id) return Boolean;
-- Determine whether E is an access type declared by an access
-- declaration, and not an (anonymous) allocator type.
elsif Ada_Version >= Ada_05
and then Is_Entity_Name (Pref)
+ and then Is_Access_Type (Etype (Pref))
and then Ekind (Directly_Designated_Type (Etype (Pref))) =
E_Incomplete_Type
and then Is_Tagged_Type (Directly_Designated_Type (Etype (Pref)))
end if;
end Check_Initialization_Call;
+ ---------------------------------------
+ -- Check_No_Direct_Boolean_Operators --
+ ---------------------------------------
+
+ procedure Check_No_Direct_Boolean_Operators (N : Node_Id) is
+ begin
+ if Scope (Entity (N)) = Standard_Standard
+ and then Root_Type (Etype (Left_Opnd (N))) = Standard_Boolean
+ then
+ -- Restriction only applies to original source code
+
+ if Comes_From_Source (N) then
+ Check_Restriction (No_Direct_Boolean_Operators, N);
+ end if;
+ end if;
+
+ if Style_Check then
+ Check_Boolean_Operator (N);
+ end if;
+ end Check_No_Direct_Boolean_Operators;
+
------------------------------
-- Check_Parameterless_Call --
------------------------------
and then (Ekind (Entity (N)) /= E_Enumeration_Literal
or else Is_Overloaded (N)))
- -- Rewrite as call if it is an explicit deference of an expression of
+ -- Rewrite as call if it is an explicit dereference of an expression of
-- a subprogram access type, and the subprogram type is not that of a
-- procedure or entry.
("ambiguous expression "
& "(cannot resolve indirect call)!", N);
else
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("ambiguous expression (cannot resolve&)!",
N, It.Nam);
end if;
elsif Nkind (N) = N_Character_Literal then
Set_Etype (N, Expr_Type);
+ elsif Nkind (N) = N_Conditional_Expression then
+ Set_Etype (N, Expr_Type);
+
-- For an explicit dereference, attribute reference, range,
-- short-circuit form (which is not an operator node), or call
-- with a name that is an explicit dereference, there is
when N_Allocator => Resolve_Allocator (N, Ctx_Type);
- when N_And_Then | N_Or_Else
+ when N_Short_Circuit
=> Resolve_Short_Circuit (N, Ctx_Type);
when N_Attribute_Reference
and then (Is_Class_Wide_Type (Designated_Type (A_Typ))
or else (Nkind (A) = N_Attribute_Reference
and then
- Is_Class_Wide_Type (Etype (Prefix (A)))))
+ Is_Class_Wide_Type (Etype (Prefix (A)))))
and then not Is_Class_Wide_Type (Designated_Type (F_Typ))
and then not Is_Controlling_Formal (F)
+
+ -- Disable these checks for call to imported C++ subprograms
+
+ and then not
+ (Is_Entity_Name (Name (N))
+ and then Is_Imported (Entity (Name (N)))
+ and then Convention (Entity (Name (N))) = Convention_CPP)
then
Error_Msg_N
("access to class-wide argument not allowed here!", A);
-- class-wide matching is not allowed.
if (Is_Class_Wide_Type (Etype (Expression (E)))
- or else Is_Class_Wide_Type (Etype (E)))
+ or else Is_Class_Wide_Type (Etype (E)))
and then Base_Type (Etype (Expression (E))) /= Base_Type (Etype (E))
then
Wrong_Type (Expression (E), Etype (E));
-- Set if corresponding operand might be negative
begin
- Determine_Range (Left_Opnd (N), OK, Lo, Hi);
+ Determine_Range
+ (Left_Opnd (N), OK, Lo, Hi, Assume_Valid => True);
LNeg := (not OK) or else Lo < 0;
- Determine_Range (Right_Opnd (N), OK, Lo, Hi);
+ Determine_Range
+ (Right_Opnd (N), OK, Lo, Hi, Assume_Valid => True);
RNeg := (not OK) or else Lo < 0;
+ -- Check if we will be generating conditionals. There are two
+ -- cases where that can happen, first for REM, the only case
+ -- is largest negative integer mod -1, where the division can
+ -- overflow, but we still have to give the right result. The
+ -- front end generates a test for this annoying case. Here we
+ -- just test if both operands can be negative (that's what the
+ -- expander does, so we match its logic here).
+
+ -- The second case is mod where either operand can be negative.
+ -- In this case, the back end has to generate additonal tests.
+
if (Nkind (N) = N_Op_Rem and then (LNeg and RNeg))
or else
(Nkind (N) = N_Op_Mod and then (LNeg or RNeg))
New_Subp := Relocate_Node (Subp);
Set_Entity (Subp, Nam);
- if Component_Type (Ret_Type) /= Any_Type then
+ if (Is_Array_Type (Ret_Type)
+ and then Component_Type (Ret_Type) /= Any_Type)
+ or else
+ (Is_Access_Type (Ret_Type)
+ and then
+ Component_Type (Designated_Type (Ret_Type)) /= Any_Type)
+ then
if Needs_No_Actuals (Nam) then
-- Indexed call to a parameterless function
procedure Resolve_Conditional_Expression (N : Node_Id; Typ : Entity_Id) is
Condition : constant Node_Id := First (Expressions (N));
Then_Expr : constant Node_Id := Next (Condition);
- Else_Expr : constant Node_Id := Next (Then_Expr);
+ Else_Expr : Node_Id := Next (Then_Expr);
+
begin
- Resolve (Condition, Standard_Boolean);
+ Resolve (Condition, Any_Boolean);
Resolve (Then_Expr, Typ);
- Resolve (Else_Expr, Typ);
+
+ -- If ELSE expression present, just resolve using the determined type
+
+ if Present (Else_Expr) then
+ Resolve (Else_Expr, Typ);
+
+ -- If no ELSE expression is present, root type must be Standard.Boolean
+ -- and we provide a Standard.True result converted to the appropriate
+ -- Boolean type (in case it is a derived boolean type).
+
+ elsif Root_Type (Typ) = Standard_Boolean then
+ Else_Expr :=
+ Convert_To (Typ, New_Occurrence_Of (Standard_True, Sloc (N)));
+ Analyze_And_Resolve (Else_Expr, Typ);
+ Append_To (Expressions (N), Else_Expr);
+
+ else
+ Error_Msg_N ("can only omit ELSE expression in Boolean case", N);
+ Append_To (Expressions (N), Error);
+ end if;
+
Set_Etype (N, Typ);
Eval_Conditional_Expression (N);
end Resolve_Conditional_Expression;
Set_Etype (N, Get_Actual_Subtype (N));
end if;
- -- Note: there is no Eval processing required for an explicit deference,
- -- because the type is known to be an allocators, and allocator
- -- expressions can never be static.
+ -- Note: No Eval processing is required for an explicit dereference,
+ -- because such a name can never be static.
end Resolve_Explicit_Dereference;
procedure Resolve_Logical_Op (N : Node_Id; Typ : Entity_Id) is
B_Typ : Entity_Id;
- N_Opr : constant Node_Kind := Nkind (N);
begin
+ Check_No_Direct_Boolean_Operators (N);
+
-- Predefined operations on scalar types yield the base type. On the
-- other hand, logical operations on arrays yield the type of the
-- arguments (and the context).
Set_Etype (N, B_Typ);
Generate_Operator_Reference (N, B_Typ);
Eval_Logical_Op (N);
-
- -- Check for violation of restriction No_Direct_Boolean_Operators
- -- if the operator was not eliminated by the Eval_Logical_Op call.
-
- if Nkind (N) = N_Opr
- and then Root_Type (Etype (Left_Opnd (N))) = Standard_Boolean
- then
- Check_Restriction (No_Direct_Boolean_Operators, N);
- end if;
end Resolve_Logical_Op;
---------------------------
procedure Resolve_Membership_Op (N : Node_Id; Typ : Entity_Id) is
pragma Warnings (Off, Typ);
- L : constant Node_Id := Left_Opnd (N);
+ L : constant Node_Id := Left_Opnd (N);
R : constant Node_Id := Right_Opnd (N);
T : Entity_Id;
+ procedure Resolve_Set_Membership;
+ -- Analysis has determined a unique type for the left operand.
+ -- Use it to resolve the disjuncts.
+
+ ----------------------------
+ -- Resolve_Set_Membership --
+ ----------------------------
+
+ procedure Resolve_Set_Membership is
+ Alt : Node_Id;
+
+ begin
+ Resolve (L, Etype (L));
+
+ Alt := First (Alternatives (N));
+ while Present (Alt) loop
+
+ -- Alternative is an expression, a range
+ -- or a subtype mark.
+
+ if not Is_Entity_Name (Alt)
+ or else not Is_Type (Entity (Alt))
+ then
+ Resolve (Alt, Etype (L));
+ end if;
+
+ Next (Alt);
+ end loop;
+ end Resolve_Set_Membership;
+
+ -- Start of processing for Resolve_Membership_Op
+
begin
if L = Error or else R = Error then
return;
end if;
- if not Is_Overloaded (R)
+ if Present (Alternatives (N)) then
+ Resolve_Set_Membership;
+ return;
+
+ elsif not Is_Overloaded (R)
and then
(Etype (R) = Universal_Integer or else
Etype (R) = Universal_Real)
-- Generate cross-reference. We needed to wait until full overloading
-- resolution was complete to do this, since otherwise we can't tell if
- -- we are an Lvalue of not.
+ -- we are an lvalue or not.
if May_Be_Lvalue (N) then
Generate_Reference (Entity (S), S, 'm');
Insert_Action (N, Act_Decl);
Array_Type := Defining_Identifier (Act_Decl);
end;
+
+ -- Maybe this should just be "else", instead of checking for the
+ -- specific case of slice??? This is needed for the case where
+ -- the prefix is an Image attribute, which gets expanded to a
+ -- slice, and so has a constrained subtype which we want to use
+ -- for the slice range check applied below (the range check won't
+ -- get done if the unconstrained subtype of the 'Image is used).
+
+ elsif Nkind (Name) = N_Slice then
+ Array_Type := Etype (Name);
end if;
-- If name was overloaded, set slice type correctly now
-- undesired dependence on such run-time unit.
and then
- (VM_Target /= No_VM
- or else not
- (RTU_Loaded (Ada_Tags)
- and then Nkind (Prefix (N)) = N_Selected_Component
- and then Present (Entity (Selector_Name (Prefix (N))))
- and then Entity (Selector_Name (Prefix (N))) =
- RTE_Record_Component (RE_Prims_Ptr)))
+ (not Tagged_Type_Expansion
+ or else not
+ (RTU_Loaded (Ada_Tags)
+ and then Nkind (Prefix (N)) = N_Selected_Component
+ and then Present (Entity (Selector_Name (Prefix (N))))
+ and then Entity (Selector_Name (Prefix (N))) =
+ RTE_Record_Component (RE_Prims_Ptr)))
then
Apply_Range_Check (Drange, Etype (Index));
end if;
and then Covers (Orig_T, Etype (Entity (Orig_N)))))
then
Error_Msg_Node_2 := Orig_T;
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("?redundant conversion, & is of type &!", N, Entity (Orig_N));
end if;
end if;
end if;
end if;
- -- Need some comments here, and a name for this block ???
+ -- In the presence of limited_with clauses we have to use non-limited
+ -- views, if available.
- declare
+ Check_Limited : declare
function Full_Designated_Type (T : Entity_Id) return Entity_Id;
-- Helper function to handle limited views
function Full_Designated_Type (T : Entity_Id) return Entity_Id is
Desig : constant Entity_Id := Designated_Type (T);
+
begin
- if From_With_Type (Desig)
- and then Is_Incomplete_Type (Desig)
+ -- Handle the limited view of a type
+
+ if Is_Incomplete_Type (Desig)
+ and then From_With_Type (Desig)
and then Present (Non_Limited_View (Desig))
then
- return Non_Limited_View (Desig);
+ return Available_View (Desig);
else
return Desig;
end if;
Same_Base : constant Boolean :=
Base_Type (Target) = Base_Type (Opnd);
- -- Start of processing for ???
+ -- Start of processing for Check_Limited
begin
if Is_Tagged_Type (Target) then
return False;
end if;
end if;
- end;
+ end Check_Limited;
-- Access to subprogram types. If the operand is an access parameter,
-- the type has a deeper accessibility that any master, and cannot
OSDN Git Service
