-- 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
-- anomalies: the subtype was first built in the subprogram
-- declaration, and the current call may be nested.
- if Nkind (Actval) = N_Aggregate
- and then Has_Discriminants (Etype (Actval))
- then
- Analyze_And_Resolve (Actval, Base_Type (Etype (Actval)));
+ if Nkind (Actval) = N_Aggregate then
+ Analyze_And_Resolve (Actval, Etype (F));
else
Analyze_And_Resolve (Actval, Etype (Actval));
end if;
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);
Check_Unset_Reference (Expression (E));
-- A qualified expression requires an exact match of the type,
- -- class-wide matching is not allowed. We skip this test in a call
- -- to a CPP constructor because in such case, although the function
- -- profile indicates that it returns a class-wide type, the object
- -- returned by the C++ constructor has a concrete type.
-
- if Is_Class_Wide_Type (Etype (Expression (E)))
- and then Is_CPP_Constructor_Call (Expression (E))
- then
- null;
+ -- class-wide matching is not allowed.
- elsif (Is_Class_Wide_Type (Etype (Expression (E)))
+ if (Is_Class_Wide_Type (Etype (Expression (E)))
or else Is_Class_Wide_Type (Etype (E)))
and then Base_Type (Etype (Expression (E))) /= Base_Type (Etype (E))
then
-- 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
Eval_Call (N);
Check_Elab_Call (N);
+ Warn_On_Overlapping_Actuals (Nam, N);
end Resolve_Call;
-------------------------------
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
-- 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
-----------------------------
procedure Resolve_Type_Conversion (N : Node_Id; Typ : Entity_Id) is
- Conv_OK : constant Boolean := Conversion_OK (N);
- Operand : constant Node_Id := Expression (N);
+ Conv_OK : constant Boolean := Conversion_OK (N);
+ Operand : constant Node_Id := Expression (N);
Operand_Typ : constant Entity_Id := Etype (Operand);
Target_Typ : constant Entity_Id := Etype (N);
Rop : Node_Id;
(Ekind (Entity (Orig_N)) = E_Loop_Parameter
and then Covers (Orig_T, Etype (Entity (Orig_N)))))
then
- Error_Msg_Node_2 := Orig_T;
- Error_Msg_NE -- CODEFIX
- ("?redundant conversion, & is of type &!", N, Entity (Orig_N));
+ -- One more check, do not give warning if the analyzed conversion
+ -- has an expression with non-static bounds, and the bounds of the
+ -- target are static. This avoids junk warnings in cases where the
+ -- conversion is necessary to establish staticness, for example in
+ -- a case statement.
+
+ if not Is_OK_Static_Subtype (Operand_Typ)
+ and then Is_OK_Static_Subtype (Target_Typ)
+ then
+ null;
+
+ -- Here we give the redundant conversion warning
+
+ else
+ Error_Msg_Node_2 := Orig_T;
+ Error_Msg_NE -- CODEFIX
+ ("?redundant conversion, & is of type &!",
+ N, Entity (Orig_N));
+ end if;
end if;
end if;
OSDN Git Service
