[multiple changes]

2009-11-30  Vincent Celier  <celier@adacore.com>

	* prj-tree.ads: Minor comment updates
	* prj-tree.adb: Minor reformatting

2009-11-30  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Derive_Subprogram): Indicate that an inherited
	predefined control operation is hidden if the parent type is not
	visibly controlled.
	* sem_ch6.adb (Check_Overriding_Indicator): Do not report error if
	overridden operation is not visible, as may be the case with predefined
	control operations.
	* sem_disp.adb (Check_Dispatching_Operation): Do not emit warning on
	non-overriding control operation when type is not visibly controlled,
	if the subprogram has an explicit overriding indicator.
	* sem_util.ads, sem_util.adb (Is_Visibly_Controlled): Moved here from
	sem_disp.adb.

From-SVN: r154791

gcc/ada/ChangeLog

+2009-11-30  Vincent Celier  <celier@adacore.com>
+
+	* prj-tree.ads: Minor comment updates
+	* prj-tree.adb: Minor reformatting
+
+2009-11-30  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Derive_Subprogram): Indicate that an inherited
+	predefined control operation is hidden if the parent type is not
+	visibly controlled.
+	* sem_ch6.adb (Check_Overriding_Indicator): Do not report error if
+	overridden operation is not visible, as may be the case with predefined
+	control operations.
+	* sem_disp.adb (Check_Dispatching_Operation): Do not emit warning on
+	non-overriding control operation when type is not visibly controlled,
+	if the subprogram has an explicit overriding indicator.
+	* sem_util.ads, sem_util.adb (Is_Visibly_Controlled): Moved here from
+	sem_disp.adb.
+
 2009-11-30  Emmanuel Briot  <briot@adacore.com>
 
 	* prj-tree.adb (Create_Attribute): Fix handling of VMS and Windows

gcc/ada/prj-tree.adb

@@ -3027,7 +3027,7 @@ package body Prj.Tree is
       return Pack;
    end Create_Package;
 
-   -------------------
+   ----------------------
    -- Create_Attribute --
    ----------------------
 

gcc/ada/sem_ch3.adb

@@ -12418,6 +12418,24 @@ package body Sem_Ch3 is
          Set_Convention (New_Subp, Convention (Parent_Subp));
       end if;
 
+      --  Predefined controlled operations retain their name even if the parent
+      --  is hidden (see above), but they are not primitive operations if the
+      --  ancestor is not visible, for example if the parent is a private
+      --  extension completed with a controlled extension. Note that a full
+      --  type that is controlled can break privacy: the flag Is_Controlled is
+      --  set on both views of the type.
+
+      if Is_Controlled (Parent_Type)
+        and then
+          (Chars (Parent_Subp) = Name_Initialize
+            or else Chars (Parent_Subp) = Name_Adjust
+            or else Chars (Parent_Subp) = Name_Finalize)
+        and then Is_Hidden (Parent_Subp)
+        and then not Is_Visibly_Controlled (Parent_Type)
+      then
+         Set_Is_Hidden (New_Subp);
+      end if;
+
       Set_Is_Imported (New_Subp, Is_Imported (Parent_Subp));
       Set_Is_Exported (New_Subp, Is_Exported (Parent_Subp));
 

gcc/ada/sem_ch6.adb

@@ -4454,7 +4454,9 @@ package body Sem_Ch6 is
          end;
       end if;
 
-      if Present (Overridden_Subp) then
+      if Present (Overridden_Subp)
+        and then not Is_Hidden (Overridden_Subp)
+      then
          if Must_Not_Override (Spec) then
             Error_Msg_Sloc := Sloc (Overridden_Subp);
 

gcc/ada/sem_disp.adb

@@ -48,7 +48,6 @@ with Sem_Eval; use Sem_Eval;
 with Sem_Type; use Sem_Type;
 with Sem_Util; use Sem_Util;
 with Snames;   use Snames;
-with Stand;    use Stand;
 with Sinfo;    use Sinfo;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
@@ -673,27 +672,6 @@ package body Sem_Disp is
       Has_Dispatching_Parent : Boolean := False;
       Body_Is_Last_Primitive : Boolean := False;
 
-      function Is_Visibly_Controlled (T : Entity_Id) return Boolean;
-      --  Check whether T is derived from a visibly controlled type.
-      --  This is true if the root type is declared in Ada.Finalization.
-      --  If T is derived instead from a private type whose full view
-      --  is controlled, an explicit Initialize/Adjust/Finalize subprogram
-      --  does not override the inherited one.
-
-      ---------------------------
-      -- Is_Visibly_Controlled --
-      ---------------------------
-
-      function Is_Visibly_Controlled (T : Entity_Id) return Boolean is
-         Root : constant Entity_Id := Root_Type (T);
-      begin
-         return Chars (Scope (Root)) = Name_Finalization
-           and then Chars (Scope (Scope (Root))) = Name_Ada
-           and then Scope (Scope (Scope (Root))) = Standard_Standard;
-      end Is_Visibly_Controlled;
-
-   --  Start of processing for Check_Dispatching_Operation
-
    begin
       if Ekind (Subp) /= E_Procedure and then Ekind (Subp) /= E_Function then
          return;
@@ -1030,8 +1008,20 @@ package body Sem_Disp is
            and then not Is_Visibly_Controlled (Tagged_Type)
          then
             Set_Is_Overriding_Operation (Subp, False);
-            Error_Msg_NE
-              ("operation does not override inherited&?", Subp, Subp);
+            --  If the subprogram specification carries an overriding
+            --  indicator, no need for the warning: it is either redundant,
+            --  or else an error will be reported.
+
+            if Nkind (Parent (Subp)) = N_Procedure_Specification
+              and then
+                (Must_Override (Parent (Subp))
+                  or else Must_Not_Override (Parent (Subp)))
+            then
+               null;
+            else
+               Error_Msg_NE
+                 ("operation does not override inherited&?", Subp, Subp);
+            end if;
          else
             Override_Dispatching_Operation (Tagged_Type, Old_Subp, Subp);
             Set_Is_Overriding_Operation (Subp);

gcc/ada/sem_util.adb

@@ -7238,6 +7238,18 @@ package body Sem_Util is
       end if;
    end Is_Variable;
 
+   ---------------------------
+   -- Is_Visibly_Controlled --
+   ---------------------------
+
+   function Is_Visibly_Controlled (T : Entity_Id) return Boolean is
+      Root : constant Entity_Id := Root_Type (T);
+   begin
+      return Chars (Scope (Root)) = Name_Finalization
+        and then Chars (Scope (Scope (Root))) = Name_Ada
+        and then Scope (Scope (Scope (Root))) = Standard_Standard;
+   end Is_Visibly_Controlled;
+
    ------------------------
    -- Is_Volatile_Object --
    ------------------------

gcc/ada/sem_util.ads

@@ -812,6 +812,13 @@ package Sem_Util is
    --  the point at which Assignment_OK is checked, and True is returned
    --  for any tree thus marked.
 
+   function Is_Visibly_Controlled (T : Entity_Id) return Boolean;
+   --  Check whether T is derived from a visibly controlled type.
+   --  This is true if the root type is declared in Ada.Finalization.
+   --  If T is derived instead from a private type whose full view
+   --  is controlled, an explicit Initialize/Adjust/Finalize subprogram
+   --  does not override the inherited one.
+
    function Is_Volatile_Object (N : Node_Id) return Boolean;
    --  Determines if the given node denotes an volatile object in the sense
    --  of the legality checks described in RM C.6(12). Note that the test