public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-1619] [Ada] Warn on 'in out' param containing access in private type
@ 2021-06-18 8:38 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-06-18 8:38 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:57841a43114d66a59322ce8b8d98b5e0096e5e36
commit r12-1619-g57841a43114d66a59322ce8b8d98b5e0096e5e36
Author: Bob Duff <duff@adacore.com>
Date: Tue Mar 16 14:56:09 2021 -0400
[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:
---
gcc/ada/sem_attr.adb | 4 +---
gcc/ada/sem_util.adb | 15 ++++-----------
gcc/ada/sem_util.ads | 20 ++++++++------------
gcc/ada/sem_warn.adb | 24 ++++++++++++------------
4 files changed, 25 insertions(+), 38 deletions(-)
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 07ce4883fd4..63b0f09ea5d 100644
--- 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 f09295baa88..a66a024105d 100644
--- 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 e387d147f62..0519b3c3fdd 100644
--- 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 d612d53dbea..b7abd1b7ab1 100644
--- 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;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-06-18 8:38 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-06-18 8:38 [gcc r12-1619] [Ada] Warn on 'in out' param containing access in private type Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).