-- Could be optimized away perhaps?
procedure Check_No_Direct_Boolean_Operators (N : Node_Id);
- -- N is the node for a comparison or 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.
+ -- 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
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)))
if Scope (Entity (N)) = Standard_Standard
and then Root_Type (Etype (Left_Opnd (N))) = Standard_Boolean
then
- -- Restriction does not apply to generated code
+ -- Restriction only applies to original source code
- if not Comes_From_Source (N) then
- null;
-
- -- Restriction does not apply for A=False, A=True
-
- elsif Nkind (N) = N_Op_Eq
- and then (Is_Entity_Name (Right_Opnd (N))
- and then (Entity (Right_Opnd (N)) = Standard_True
- or else
- Entity (Right_Opnd (N)) = Standard_False))
- then
- null;
-
- -- Otherwise restriction applies
-
- else
+ 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;
------------------------------
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.
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
T : Entity_Id;
begin
- Check_No_Direct_Boolean_Operators (N);
-
-- If this is an intrinsic operation which is not predefined, use the
-- types of its declared arguments to resolve the possibly overloaded
-- operands. Otherwise the operands are unambiguous and specify the
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;
-- Start of processing for Resolve_Equality_Op
begin
- Check_No_Direct_Boolean_Operators (N);
-
Set_Etype (N, Base_Type (Typ));
Generate_Reference (T, N, ' ');
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_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
--------------------------
function Full_Designated_Type (T : Entity_Id) return Entity_Id is
- Desig : Entity_Id := Designated_Type (T);
+ Desig : constant Entity_Id := Designated_Type (T);
begin
+ -- 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
- Desig := Non_Limited_View (Desig);
-
- -- The shadow entity's non-limited view may designate an
- -- incomplete type.
-
- if Is_Incomplete_Type (Desig)
- and then Present (Full_View (Desig))
- then
- Desig := Full_View (Desig);
- end if;
+ return Available_View (Desig);
+ else
+ return Desig;
end if;
-
- return Desig;
end Full_Designated_Type;
-- Local Declarations