[multiple changes]

2017-09-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_warn.adb (Warn_On_Overlapping_Actuals): Refine previous
	fix and preserve older GNAT warning on overlapping actuals that
	are not elementary types.

2017-09-06  Justin Squirek  <squirek@adacore.com>

	* sem_attr.adb: Comment correction.

From-SVN: r251771

3 files changed, 47 insertions, 15 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a8264d6..5e6d0af 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2017-09-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_warn.adb (Warn_On_Overlapping_Actuals): Refine previous
+	fix and preserve older GNAT warning on overlapping actuals that
+	are not elementary types.
+
+2017-09-06  Justin Squirek  <squirek@adacore.com>
+
+	* sem_attr.adb: Comment correction.
+
 2017-09-06  Gary Dismukes  <dismukes@adacore.com>
 
 	* sem_util.adb: Minor reformatting.
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 87dc50f..436c359 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -364,7 +364,8 @@ package body Sem_Attr is
       --  Check that P is an object reference
 
       procedure Check_Object_Reference_Image (Str_Typ : Entity_Id);
-      --  Verify that the prefix of an image attribute.... ???
+      --  Verify that the prefix of an image attribute is an object reference
+      --  and set the Etype of the prefix to that specified by Str_Typ.
 
       procedure Check_PolyORB_Attribute;
       --  Validity checking for PolyORB/DSA attribute
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index c181072..962e919 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -3608,10 +3608,14 @@ package body Sem_Warn is
 
       --  Local variables
 
-      Act1  : Node_Id;
-      Act2  : Node_Id;
-      Form1 : Entity_Id;
-      Form2 : Entity_Id;
+      Act1       : Node_Id;
+      Act2       : Node_Id;
+      Form1      : Entity_Id;
+      Form2      : Entity_Id;
+      Warn_Only  : Boolean;
+      --  GNAT warns on overlapping in-out parameters even when there
+      --  sre no two in-out parameters of an elementary type, as stated in
+      --  RM 6.5.1 (17/2).
 
    --  Start of processing for Warn_On_Overlapping_Actuals
 
@@ -3621,6 +3625,29 @@ package body Sem_Warn is
          return;
       end if;
 
+      --  The call is illegal only if there are at least two in-out
+      --  parameters of the same elementary type.
+
+      Warn_Only := True;
+      Form1 := First_Formal (Subp);
+      while Present (Form1) loop
+         Form2 := Next_Formal (Form1);
+         while Present (Form2) loop
+            if Is_Elementary_Type (Etype (Form1))
+              and then Is_Elementary_Type (Etype (Form2))
+              and then Ekind (Form1) /= E_In_Parameter
+              and then Ekind (Form2) /= E_In_Parameter
+            then
+               Warn_Only := False;
+               exit;
+            end if;
+
+            Next_Formal (Form2);
+         end loop;
+
+         Next_Formal (Form1);
+      end loop;
+
       --  Exclude calls rewritten as enumeration literals
 
       if Nkind (N) not in N_Subprogram_Call
@@ -3684,14 +3711,6 @@ package body Sem_Warn is
                   then
                      null;
 
-                  --  If the types of the formals are different there can
-                  --  be no aliasing (even though there might be overlap
-                  --  through address clauses, which must be intentional).
-
-                  elsif Base_Type (Etype (Form1)) /= Base_Type (Etype (Form2))
-                  then
-                     null;
-
                   --  Here we may need to issue overlap message
 
                   else
@@ -3708,10 +3727,12 @@ package body Sem_Warn is
 
                        or else not Is_Elementary_Type (Etype (Form1))
 
-                       --  Finally, debug flag -gnatd.E changes the error to a
+                       --  debug flag -gnatd.E changes the error to a
                        --  warning even in Ada 2012 mode.
 
-                       or else Error_To_Warning;
+                       or else Error_To_Warning
+
+                       or else Warn_Only;
 
                      declare
                         Act  : Node_Id;