[Ada] Warn on 'in out' param containing access in private type

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
index 07ce4883fd4ef580c34ff26750a781a0915b033f..63b0f09ea5d464662ce0e7ece87945532b48bd06 100644 (file)
--- 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
index f09295baa88eb45b3bf6ebef7969862aa2637a87..a66a024105d085cff6c3af135d31492119c39da2 100644 (file)
--- 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
index e387d147f62eb58a7c78804dd51dbc57326b041f..0519b3c3fdd146155dd43710e77f4ff2f76643fe 100644 (file)
--- 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
index d612d53dbea9701e79053ff484e5237138279126..b7abd1b7ab12d8537f01642fff9c3469886cc83e 100644 (file)
--- 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;