From: Arnaud Charlet <charlet@gcc.gnu.org>
Date: Wed, 4 Mar 2015 09:58:41 +0000 (+0100)
Subject: [multiple changes]
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=26f36fc9f65e8bcc265d62996d65616e437fb3fa;p=gcc.git

[multiple changes]

2015-03-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_warn.adb (Check_References): When checking for an unused
	in-out parameter of a class- wide type, use its type to determine
	whether it is private, in order to avoid a spurious warning when
	subprogram spec and body are in different units.

2015-03-04  Yannick Moy  <moy@adacore.com>

	* sem_attr.adb: Improve warning messages.

From-SVN: r221178
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4ac44b3ca31..065a991727a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2015-03-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_warn.adb (Check_References): When checking for an unused
+	in-out parameter of a class- wide type, use its type to determine
+	whether it is private, in order to avoid a spurious warning when
+	subprogram spec and body are in different units.
+
+2015-03-04  Yannick Moy  <moy@adacore.com>
+
+	* sem_attr.adb: Improve warning messages.
+
 2015-03-04  Robert Dewar  <dewar@adacore.com>
 
 	* exp_ch6.adb (Expand_N_Subprogram_Body): Avoid trying to unnest
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 21040ab97e8..01b0cd8e885 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1103,6 +1103,10 @@ package body Sem_Attr is
          --  Subsidiary to Check_Placemenet_In_XXX. Determine whether arbitrary
          --  node Nod is within enclosing node Encl_Nod.
 
+         procedure Placement_Error;
+         --  Emit a general error when the attributes does not appear in a
+         --  postcondition-like aspect or pragma.
+
          ------------------------------
          -- Check_Placement_In_Check --
          ------------------------------
@@ -1124,17 +1128,7 @@ package body Sem_Attr is
             --  Otherwise the placement of the attribute is illegal
 
             else
-               if Aname = Name_Old then
-                  Error_Attr
-                    ("attribute % can only appear in postcondition", P);
-
-               --  Specialize the error message for attribute 'Result
-
-               else
-                  Error_Attr
-                    ("attribute % can only appear in postcondition of "
-                     & "function", P);
-               end if;
+               Placement_Error;
             end if;
          end Check_Placement_In_Check;
 
@@ -1236,6 +1230,24 @@ package body Sem_Attr is
             return False;
          end Is_Within;
 
+         ---------------------
+         -- Placement_Error --
+         ---------------------
+
+         procedure Placement_Error is
+         begin
+            if Aname = Name_Old then
+               Error_Attr ("attribute % can only appear in postcondition", P);
+
+            --  Specialize the error message for attribute 'Result
+
+            else
+               Error_Attr
+                 ("attribute % can only appear in postcondition of function",
+                  P);
+            end if;
+         end Placement_Error;
+
          --  Local variables
 
          Prag      : Node_Id;
@@ -1294,14 +1306,14 @@ package body Sem_Attr is
                Check_Placement_In_Test_Case (Prag);
 
             else
-               Error_Attr ("attribute % can only appear in postcondition", P);
+               Placement_Error;
                return;
             end if;
 
          --  Otherwise the placement of the attribute is illegal
 
          else
-            Error_Attr ("attribute % can only appear in postcondition", P);
+            Placement_Error;
             return;
          end if;
 
@@ -4797,7 +4809,7 @@ package body Sem_Attr is
             if Is_Constant_Object (Pref_Id) then
                Error_Msg_Name_1 := Name_Old;
                Error_Msg_N
-                 ("??atribute % applied to constant has no effect", P);
+                 ("??attribute % applied to constant has no effect", P);
             end if;
 
          --  Otherwise the prefix is not a simple name
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index b0e80116225..f3768621399 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -1080,6 +1080,13 @@ package body Sem_Warn is
                 (Ekind_In (E1, E_Out_Parameter, E_In_Out_Parameter)
                   and then not Is_Protected_Type (Current_Scope))
             then
+               --  If the formal has a class-wide type, retrieve its type
+               --  because checks below depend on its private nature.
+
+               if Is_Class_Wide_Type (E1T) then
+                  E1T := Etype (E1T);
+               end if;
+
                --  Case of an unassigned variable
 
                --  First gather any Unset_Reference indication for E1. In the