Normally the warnings:
warning: formal parameter "..." is not modified
warning: mode could be "in" instead of "in out"
are disabled if the type contains components of an access type.
A previous patch enabled such warnings if the only such components
are in internal private types.
This patch goes further, to all private types, whether or not internal.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* sem_util.ads, sem_util.adb (Has_Access_Values): Remove
Include_Internal parameter that was added in previous change.
* sem_warn.adb (Warnings_Off_E1): Back out E_Out_Parameter ==>
Formal_Kind change made previously. Check Is_Private_Type to
avoid warnings on private types. Misc cleanup.
* sem_attr.adb (Attribute_Has_Access_Values): Remove
Include_Internal parameter.diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -8830,9 +8830,7 @@ package body Sem_Attr is
when Attribute_Has_Access_Values =>
Rewrite (N, New_Occurrence_Of
- (Boolean_Literals
- (Has_Access_Values (P_Root_Type, Include_Internal => True)),
- Loc));
+ (Boolean_Literals (Has_Access_Values (P_Root_Type)), Loc));
Analyze_And_Resolve (N, Standard_Boolean);
-----------------------
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -11555,14 +11555,13 @@ package body Sem_Util is
-- Has_Access_Values --
-----------------------
- function Has_Access_Values
- (T : Entity_Id; Include_Internal : Boolean) return Boolean
+ function Has_Access_Values (T : Entity_Id) return Boolean
is
Typ : constant Entity_Id := Underlying_Type (T);
begin
-- Case of a private type which is not completed yet. This can only
- -- happen in the case of a generic format type appearing directly, or
+ -- happen in the case of a generic formal type appearing directly, or
-- as a component of the type to which this function is being applied
-- at the top level. Return False in this case, since we certainly do
-- not know that the type contains access types.
@@ -11570,17 +11569,11 @@ package body Sem_Util is
if No (Typ) then
return False;
- elsif not Include_Internal
- and then T /= Typ
- and then In_Internal_Unit (Typ)
- then
- return False;
-
elsif Is_Access_Type (Typ) then
return True;
elsif Is_Array_Type (Typ) then
- return Has_Access_Values (Component_Type (Typ), Include_Internal);
+ return Has_Access_Values (Component_Type (Typ));
elsif Is_Record_Type (Typ) then
declare
@@ -11595,7 +11588,7 @@ package body Sem_Util is
-- Check for access component, tag field does not count, even
-- though it is implemented internally using an access type.
- if Has_Access_Values (Etype (Comp), Include_Internal)
+ if Has_Access_Values (Etype (Comp))
and then Chars (Comp) /= Name_uTag
then
return True;
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1312,18 +1312,14 @@ package Sem_Util is
-- limited, packed array and other implementation types. If Include_PAT
-- is False, don't look inside packed array types.
- function Has_Access_Values
- (T : Entity_Id; Include_Internal : Boolean) return Boolean;
- -- Returns true if type or subtype T is an access type, or has a component
- -- (at any recursive level) that is an access type. This is a conservative
- -- predicate, if it is not known whether or not T contains access values
- -- (happens for generic formals in some cases), then False is returned.
- -- Note that tagged types return False. Even though the tag is implemented
- -- as an access type internally, this function tests only for access types
- -- known to the programmer. See also Has_Tagged_Component.
- --
- -- If Include_Internal is False, we return False for internal private types
- -- whose full type contains access types.
+ function Has_Access_Values (T : Entity_Id) return Boolean;
+ -- Returns true if the underlying type of T is an access type, or has a
+ -- component (at any recursive level) that is an access type. This is a
+ -- conservative predicate, if it is not known whether or not T contains
+ -- access values (happens for generic formals in some cases), then False is
+ -- returned. Note that tagged types return False. Even though the tag is
+ -- implemented as an access type internally, this function tests only for
+ -- access types known to the programmer. See also Has_Tagged_Component.
function Has_Anonymous_Access_Discriminant (Typ : Entity_Id) return Boolean;
-- Returns True if Typ has one or more anonymous access discriminants
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -1180,9 +1180,10 @@ package body Sem_Warn is
-- Case of an unassigned variable
-- First gather any Unset_Reference indication for E1. In the
- -- case of a parameter, it is the Spec_Entity that is relevant.
+ -- case of an 'out' parameter, it is the Spec_Entity that is
+ -- relevant.
- if Ekind (E1) in Formal_Kind
+ if Ekind (E1) = E_Out_Parameter
and then Present (Spec_Entity (E1))
then
UR := Unset_Reference (Spec_Entity (E1));
@@ -1219,8 +1220,8 @@ package body Sem_Warn is
-- the wanted effect is included in Never_Set_In_Source.
elsif Warn_On_Constant
- and then (Ekind (E1) = E_Variable
- and then Has_Initial_Value (E1))
+ and then Ekind (E1) = E_Variable
+ and then Has_Initial_Value (E1)
and then Never_Set_In_Source_Check_Spec (E1)
and then not Generic_Package_Spec_Entity (E1)
then
@@ -1298,9 +1299,9 @@ package body Sem_Warn is
-- never referenced, since again it seems odd to rely on
-- default initialization to set an out parameter value.
- and then (Is_Access_Type (E1T)
- or else Ekind (E1) = E_Out_Parameter
- or else not Is_Fully_Initialized_Type (E1T))
+ and then (Is_Access_Type (E1T)
+ or else Ekind (E1) = E_Out_Parameter
+ or else not Is_Fully_Initialized_Type (E1T))
then
-- Do not output complaint about never being assigned a
-- value if a pragma Unmodified applies to the variable
@@ -1354,13 +1355,12 @@ package body Sem_Warn is
-- Suppress warning if composite type contains any access
-- component, since the logical effect of modifying a
-- parameter may be achieved by modifying a referenced
- -- object. This rationale does not apply to internal
- -- private types, so we warn even if a component is of
- -- something like Unbounded_String.
+ -- object. This rationale does not apply to private
+ -- types, so we warn in that case.
elsif Is_Composite_Type (E1T)
- and then Has_Access_Values
- (E1T, Include_Internal => False)
+ and then not Is_Private_Type (E1T)
+ and then Has_Access_Values (E1T)
then
null;
