public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-1595] [Ada] Warn on 'in out' param containing access in predefined private type
@ 2021-06-17 14:35 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-06-17 14:35 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:4892e31daceb8ab230768a15eb0a01b814e8bbfd
commit r12-1595-g4892e31daceb8ab230768a15eb0a01b814e8bbfd
Author: Bob Duff <duff@adacore.com>
Date: Thu Mar 11 17:20:41 2021 -0500
[Ada] Warn on 'in out' param containing access in predefined private type
gcc/ada/
* sem_util.adb, sem_util.ads (Has_Access_Values): New formal
Include_Internal to indicate whether internal types should be
included.
* sem_warn.adb (Check_References): Change E_Out_Parameter to
Formal_Kind, to match the comment about Spec_Entity. Pass
Include_Internal => False to Has_Access_Values, so that we warn
on types with access values that happen to be in internal types,
such as Unbounded_String.
* sem_attr.adb (Attribute_Has_Access_Values): Pass
Include_Internal => True to Has_Access_Values, to preserve
existing behavior.
* libgnat/g-rewdat.adb (Do_Output): Change B from 'in out' to
'in', to avoid warning enabled by the change to sem_warn.adb.
* libgnat/s-objrea.adb (Check_Read_Offset): Change S from 'in
out' to 'in', to avoid warning enabled by the change to
sem_warn.adb.
Diff:
---
gcc/ada/libgnat/g-rewdat.adb | 4 ++--
gcc/ada/libgnat/s-objrea.adb | 4 ++--
gcc/ada/sem_attr.adb | 4 +++-
gcc/ada/sem_util.adb | 14 +++++++++++---
gcc/ada/sem_util.ads | 6 +++++-
gcc/ada/sem_warn.adb | 11 +++++++----
6 files changed, 30 insertions(+), 13 deletions(-)
diff --git a/gcc/ada/libgnat/g-rewdat.adb b/gcc/ada/libgnat/g-rewdat.adb
index c257afa4c4f..3b4a0d02b41 100644
--- a/gcc/ada/libgnat/g-rewdat.adb
+++ b/gcc/ada/libgnat/g-rewdat.adb
@@ -37,7 +37,7 @@ package body GNAT.Rewrite_Data is
subtype SEO is Stream_Element_Offset;
procedure Do_Output
- (B : in out Buffer;
+ (B : Buffer;
Data : Stream_Element_Array;
Output : not null access procedure (Data : Stream_Element_Array));
-- Do the actual output. This ensures that we properly send the data
@@ -81,7 +81,7 @@ package body GNAT.Rewrite_Data is
---------------
procedure Do_Output
- (B : in out Buffer;
+ (B : Buffer;
Data : Stream_Element_Array;
Output : not null access procedure (Data : Stream_Element_Array))
is
diff --git a/gcc/ada/libgnat/s-objrea.adb b/gcc/ada/libgnat/s-objrea.adb
index 50be05a1792..b5ca32fdbc9 100644
--- a/gcc/ada/libgnat/s-objrea.adb
+++ b/gcc/ada/libgnat/s-objrea.adb
@@ -47,7 +47,7 @@ package body System.Object_Reader is
function Trim_Trailing_Nuls (Str : String) return String;
-- Return a copy of a string with any trailing NUL characters truncated
- procedure Check_Read_Offset (S : in out Mapped_Stream; Size : uint32);
+ procedure Check_Read_Offset (S : Mapped_Stream; Size : uint32);
-- Check that the SIZE bytes at the current offset are still in the stream
-------------------------------------
@@ -1931,7 +1931,7 @@ package body System.Object_Reader is
return To_String_Ptr_Len (Read (S));
end Read;
- procedure Check_Read_Offset (S : in out Mapped_Stream; Size : uint32) is
+ procedure Check_Read_Offset (S : Mapped_Stream; Size : uint32) is
begin
if S.Off + Offset (Size) > Offset (Last (S.Region)) then
raise IO_Error with "could not read from object file";
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 63b0f09ea5d..07ce4883fd4 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -8830,7 +8830,9 @@ package body Sem_Attr is
when Attribute_Has_Access_Values =>
Rewrite (N, New_Occurrence_Of
- (Boolean_Literals (Has_Access_Values (P_Root_Type)), Loc));
+ (Boolean_Literals
+ (Has_Access_Values (P_Root_Type, Include_Internal => True)),
+ Loc));
Analyze_And_Resolve (N, Standard_Boolean);
-----------------------
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index b71efde8567..47b6a93e150 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -11539,7 +11539,9 @@ package body Sem_Util is
-- Has_Access_Values --
-----------------------
- function Has_Access_Values (T : Entity_Id) return Boolean is
+ function Has_Access_Values
+ (T : Entity_Id; Include_Internal : Boolean) return Boolean
+ is
Typ : constant Entity_Id := Underlying_Type (T);
begin
@@ -11552,11 +11554,17 @@ 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));
+ return Has_Access_Values (Component_Type (Typ), Include_Internal);
elsif Is_Record_Type (Typ) then
declare
@@ -11571,7 +11579,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))
+ if Has_Access_Values (Etype (Comp), Include_Internal)
and then Chars (Comp) /= Name_uTag
then
return True;
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index b8ad3820185..1d4bd168968 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1312,7 +1312,8 @@ 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) return Boolean;
+ 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
@@ -1320,6 +1321,9 @@ package Sem_Util is
-- 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_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 728927433da..e85f4930175 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -1182,7 +1182,7 @@ package body Sem_Warn is
-- First gather any Unset_Reference indication for E1. In the
-- case of a parameter, it is the Spec_Entity that is relevant.
- if Ekind (E1) = E_Out_Parameter
+ if Ekind (E1) in Formal_Kind
and then Present (Spec_Entity (E1))
then
UR := Unset_Reference (Spec_Entity (E1));
@@ -1354,10 +1354,13 @@ 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.
+ -- object. This rationale does not apply to internal
+ -- private types, so we warn even if a component is of
+ -- something like Unbounded_String.
elsif Is_Composite_Type (E1T)
- and then Has_Access_Values (E1T)
+ and then Has_Access_Values
+ (E1T, Include_Internal => False)
then
null;
@@ -3090,7 +3093,7 @@ package body Sem_Warn is
-- Here we generate the warning
else
- -- If -gnatwk is set then output message that we could be IN
+ -- If -gnatwk is set then output message that it could be IN
if not Is_Trivial_Subprogram (Scope (E1)) then
if Warn_On_Constant then
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-06-17 14:35 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-06-17 14:35 [gcc r12-1595] [Ada] Warn on 'in out' param containing access in predefined 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).