[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 4ac44b3ca3184b4ca8a877167ac3aa2b67b5ad87..065a991727a5982970d5d62edce2c31fbb53cf2a 100644 (file)
--- 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 21040ab97e8cc78d1ab97e55715e3a534fcc123a..01b0cd8e8851c3b9d9f5875a4bd39aac9937c754 100644 (file)
--- 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 b0e80116225e58012f06de9e35025c5228028f26..f3768621399f306d8718db45a11e1415e3d34d6d 100644 (file)
--- 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