[multiple changes]

2010-10-22  Thomas Quinot  <quinot@adacore.com>

	* einfo.ads (Declaration_Node): Clarify documentation, in particular
	regarding what is returned for subprogram entities.

2010-10-22  Arnaud Charlet  <charlet@adacore.com>

	* exp_attr.adb (Make_Range_Test): Generate a Range node instead of
	explicit comparisons, generates simpler expanded code.
	* a-except-2005.adb (Rcheck_06_Ext): New.
	* gcc-interface/trans.c (gigi, gnat_to_gnu): Handle validity checks
	like range checks.
	* gcc-interface/Make-lang.in: Update dependencies.

2010-10-22  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb (Array_Type_Declaration): Error for subtype wi predicate
	for index type
	(Constrain_Index): Error of subtype wi predicate in index constraint
	* sem_ch9.adb (Analyze_Entry_Declaration): Error of subtype wi
	predicate in entry family.
	* sem_res.adb (Resolve_Slice): Error of type wi predicate in slice.

2010-10-22  Javier Miranda  <miranda@adacore.com>

	* sem_util.ads, sem_util.adb (Collect_Parents): New subprogram.
	(Original_Corresponding_Operation): New subprogram.
	(Visible_Ancestors): New subprogram.
	* sem_ch6.adb (New_Overloaded_Entity): Handle new case of dispatching
	operation that overrides a hidden inherited primitive.
	* sem_disp.adb (Find_Hidden_Overridden_Primitive): New subprogram.
	(Check_Dispatching_Operation): if the new dispatching operation
	does not override a visible primtive then check if it overrides
	some hidden inherited primitive.

2010-10-22  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch10.adb (Analyze_With_Clause): If the parent_unit_name in a with
	clause is a child unit that denotes a renaming, replace the
	parent_unit_name with a reference to the renamed unit, because the
	prefix is irrelevant to subsequent visibility..

From-SVN: r165805

14 files changed, 415 insertions, 50 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b396ff6..07ce0f5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,45 @@
+2010-10-22  Thomas Quinot  <quinot@adacore.com>
+
+	* einfo.ads (Declaration_Node): Clarify documentation, in particular
+	regarding what is returned for subprogram entities.
+
+2010-10-22  Arnaud Charlet  <charlet@adacore.com>
+
+	* exp_attr.adb (Make_Range_Test): Generate a Range node instead of
+	explicit comparisons, generates simpler expanded code.
+	* a-except-2005.adb (Rcheck_06_Ext): New.
+	* gcc-interface/trans.c (gigi, gnat_to_gnu): Handle validity checks
+	like range checks.
+	* gcc-interface/Make-lang.in: Update dependencies.
+
+2010-10-22  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch3.adb (Array_Type_Declaration): Error for subtype wi predicate
+	for index type
+	(Constrain_Index): Error of subtype wi predicate in index constraint
+	* sem_ch9.adb (Analyze_Entry_Declaration): Error of subtype wi
+	predicate in entry family.
+	* sem_res.adb (Resolve_Slice): Error of type wi predicate in slice.
+
+2010-10-22  Javier Miranda  <miranda@adacore.com>
+
+	* sem_util.ads, sem_util.adb (Collect_Parents): New subprogram.
+	(Original_Corresponding_Operation): New subprogram.
+	(Visible_Ancestors): New subprogram.
+	* sem_ch6.adb (New_Overloaded_Entity): Handle new case of dispatching
+	operation that overrides a hidden inherited primitive.
+	* sem_disp.adb (Find_Hidden_Overridden_Primitive): New subprogram.
+	(Check_Dispatching_Operation): if the new dispatching operation
+	does not override a visible primtive then check if it overrides
+	some hidden inherited primitive.
+
+2010-10-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch10.adb (Analyze_With_Clause): If the parent_unit_name in a with
+	clause is a child unit that denotes a renaming, replace the
+	parent_unit_name with a reference to the renamed unit, because the
+	prefix is irrelevant to subsequent visibility..
+
 2010-10-22  Robert Dewar  <dewar@adacore.com>
 
 	* einfo.ads, einfo.adb (Has_Predicates): Flag is now on all entities
diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb
index 48574e2..b535607 100644
--- a/gcc/ada/a-except-2005.adb
+++ b/gcc/ada/a-except-2005.adb
@@ -469,6 +469,8 @@ package body Ada.Exceptions is
      (File : System.Address; Line, Column : Integer);
    procedure Rcheck_05_Ext
      (File : System.Address; Line, Column, Index, First, Last : Integer);
+   procedure Rcheck_06_Ext
+     (File : System.Address; Line, Column, Index, First, Last : Integer);
    procedure Rcheck_12_Ext
      (File : System.Address; Line, Column, Index, First, Last : Integer);
 
@@ -509,6 +511,7 @@ package body Ada.Exceptions is
 
    pragma Export (C, Rcheck_00_Ext, "__gnat_rcheck_00_ext");
    pragma Export (C, Rcheck_05_Ext, "__gnat_rcheck_05_ext");
+   pragma Export (C, Rcheck_06_Ext, "__gnat_rcheck_06_ext");
    pragma Export (C, Rcheck_12_Ext, "__gnat_rcheck_12_ext");
 
    --  None of these procedures ever returns (they raise an exception!). By
@@ -551,6 +554,7 @@ package body Ada.Exceptions is
 
    pragma No_Return (Rcheck_00_Ext);
    pragma No_Return (Rcheck_05_Ext);
+   pragma No_Return (Rcheck_06_Ext);
    pragma No_Return (Rcheck_12_Ext);
 
    ---------------------------------------------
@@ -1236,6 +1240,17 @@ package body Ada.Exceptions is
       Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
    end Rcheck_05_Ext;
 
+   procedure Rcheck_06_Ext
+     (File : System.Address; Line, Column, Index, First, Last : Integer)
+   is
+      Msg : constant String :=
+              Rmsg_06 (Rmsg_06'First .. Rmsg_06'Last - 1) & ASCII.LF &
+              "value " & Image (Index) & " not in " & Image (First) &
+              ".." & Image (Last) & ASCII.NUL;
+   begin
+      Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
+   end Rcheck_06_Ext;
+
    procedure Rcheck_12_Ext
      (File : System.Address; Line, Column, Index, First, Last : Integer)
    is
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index febac6d..e45d3d7 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -692,13 +692,15 @@ package Einfo is
 --       details of the use of this field.
 
 --    Declaration_Node (synthesized)
---       Applies to all entities. Returns the tree node for the declaration
---       that declared the entity. Normally this is just the Parent of the
---       entity. One exception arises with child units, where the parent of
---       the entity is a selected component or a defining program unit name.
---       Another exception is that if the entity is an incomplete type that
---       has been completed, then we obtain the declaration node denoted by
---       the full type, i.e. the full type declaration node.
+--       Applies to all entities. Returns the tree node for the construct that
+--       declared the entity. Normally this is just the Parent of the entity.
+--       One exception arises with child units, where the parent of the entity
+--       is a selected component/defining program unit name. Another exception
+--       is that if the entity is an incomplete type that has been completed,
+--       then we obtain the declaration node denoted by the full type, i.e. the
+--       full type declaration node. Also note that for subprograms, this
+--       returns the {function,procedure}_specification, not the subprogram_
+--       declaration.
 
 --    Default_Expr_Function (Node21)
 --       Present in parameters. It holds the entity of the parameterless
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 6d676ac..2e1073b 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -4711,9 +4711,7 @@ package body Exp_Attr is
 
          function Make_Range_Test return Node_Id;
          --  Build the code for a range test of the form
-         --    Btyp!(Pref) >= Btyp!(Ptyp'First)
-         --      and then
-         --    Btyp!(Pref) <= Btyp!(Ptyp'Last)
+         --    Btyp!(Pref) in Btyp!(Ptyp'First) .. Btyp!(Ptyp'Last)
 
          ---------------------
          -- Make_Range_Test --
@@ -4732,24 +4730,17 @@ package body Exp_Attr is
             end if;
 
             return
-              Make_And_Then (Loc,
-                Left_Opnd =>
-                  Make_Op_Ge (Loc,
-                    Left_Opnd =>
-                      Unchecked_Convert_To (Btyp, Temp),
-
-                    Right_Opnd =>
+              Make_In (Loc,
+                Left_Opnd  =>
+                  Unchecked_Convert_To (Btyp, Temp),
+                Right_Opnd =>
+                  Make_Range (Loc,
+                    Low_Bound =>
                       Unchecked_Convert_To (Btyp,
                         Make_Attribute_Reference (Loc,
                           Prefix => New_Occurrence_Of (Ptyp, Loc),
-                          Attribute_Name => Name_First))),
-
-                Right_Opnd =>
-                  Make_Op_Le (Loc,
-                    Left_Opnd =>
-                      Unchecked_Convert_To (Btyp, Temp),
-
-                    Right_Opnd =>
+                          Attribute_Name => Name_First)),
+                    High_Bound =>
                       Unchecked_Convert_To (Btyp,
                         Make_Attribute_Reference (Loc,
                           Prefix => New_Occurrence_Of (Ptyp, Loc),
diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in
index 8ead8b6..693619e 100644
--- a/gcc/ada/gcc-interface/Make-lang.in
+++ b/gcc/ada/gcc-interface/Make-lang.in
@@ -1797,20 +1797,21 @@ ada/exp_ch12.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
 ada/exp_ch13.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
    ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
-   ada/einfo.adb ada/elists.ads ada/elists.adb ada/exp_ch13.ads \
-   ada/exp_ch13.adb ada/exp_ch3.ads ada/exp_ch6.ads ada/exp_imgv.ads \
-   ada/exp_tss.ads ada/exp_util.ads ada/gnat.ads ada/g-htable.ads \
-   ada/hostparm.ads ada/namet.ads ada/nlists.ads ada/nlists.adb \
-   ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads ada/rtsfind.ads \
-   ada/sem.ads ada/sem_aux.ads ada/sem_ch3.ads ada/sem_ch7.ads \
-   ada/sem_ch8.ads ada/sem_eval.ads ada/sem_util.ads ada/sinfo.ads \
-   ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
-   ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \
-   ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-stalib.ads \
-   ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
-   ada/table.ads ada/table.adb ada/tbuild.ads ada/tree_io.ads \
-   ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
-   ada/unchdeal.ads ada/urealp.ads ada/validsw.ads 
+   ada/einfo.adb ada/elists.ads ada/elists.adb ada/err_vars.ads \
+   ada/errout.ads ada/erroutc.ads ada/exp_ch13.ads ada/exp_ch13.adb \
+   ada/exp_ch3.ads ada/exp_ch6.ads ada/exp_imgv.ads ada/exp_tss.ads \
+   ada/exp_util.ads ada/gnat.ads ada/g-htable.ads ada/hostparm.ads \
+   ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
+   ada/opt.ads ada/output.ads ada/rtsfind.ads ada/sem.ads ada/sem_aux.ads \
+   ada/sem_ch3.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_eval.ads \
+   ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
+   ada/snames.ads ada/stand.ads ada/system.ads ada/s-exctab.ads \
+   ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
+   ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads \
+   ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
+   ada/tbuild.ads ada/tree_io.ads ada/types.ads ada/uintp.ads \
+   ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
+   ada/validsw.ads 
 
 ada/exp_ch2.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 90be61c..f159836 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -482,8 +482,9 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
 	gnat_raise_decls_ext[i]
 	  = build_raise_check (i, t,
 			       i == CE_Index_Check_Failed
-			       || i == CE_Range_Check_Failed ?
-			       exception_range : exception_column);
+			       || i == CE_Range_Check_Failed
+			       || i == CE_Invalid_Data
+			       ? exception_range : exception_column);
     }
 
   /* Set the types that GCC and Gigi use from the front end.  */
@@ -5518,7 +5519,8 @@ gnat_to_gnu (Node_Id gnat_node)
 		gnu_result = build_call_raise_column (reason, gnat_node);
 	      }
 	    else if ((reason == CE_Index_Check_Failed
-		      || reason == CE_Range_Check_Failed)
+		      || reason == CE_Range_Check_Failed
+		      || reason == CE_Invalid_Data)
 		     && Nkind (cond) == N_Op_Not
 		     && Nkind (Right_Opnd (cond)) == N_In
 		     && Nkind (Right_Opnd (Right_Opnd (cond))) == N_Range)
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 89dda5d..9ddde90 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -2556,6 +2556,22 @@ package body Sem_Ch10 is
          Par_Name := Scope (E_Name);
          while Nkind (Pref) = N_Selected_Component loop
             Change_Selected_Component_To_Expanded_Name (Pref);
+
+            if Present (Entity (Selector_Name (Pref)))
+              and then
+                Present (Renamed_Entity (Entity (Selector_Name (Pref))))
+              and then Entity (Selector_Name (Pref)) /= Par_Name
+            then
+
+            --  The prefix is a child unit that denotes a renaming
+            --  declaration. Replace the prefix directly with the renamed
+            --  unit, because the rest of the prefix is irrelevant to the
+            --  visibility of the real unit.
+
+               Rewrite (Pref, New_Occurrence_Of (Par_Name, Sloc (Pref)));
+               exit;
+            end if;
+
             Set_Entity_With_Style_Check (Pref, Par_Name);
 
             Generate_Reference (Par_Name, Pref);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 335d348..22d2fdf 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -446,7 +446,7 @@ package body Sem_Ch3 is
       Related_Id   : Entity_Id;
       Suffix       : Character;
       Suffix_Index : Nat);
-   --  Process an index constraint in a constrained array declaration. The
+   --  Process an index constraint S in a constrained array declaration. The
    --  constraint can be a subtype name, or a range with or without an explicit
    --  subtype mark. The index is the corresponding index of the unconstrained
    --  array. The Related_Id and Suffix parameters are used to build the
@@ -4424,6 +4424,17 @@ package body Sem_Ch3 is
          end if;
 
          Make_Index (Index, P, Related_Id, Nb_Index);
+
+         --  Check error of subtype with predicate for index type
+
+         if Has_Predicates (Etype (Index)) then
+            Error_Msg_NE
+              ("subtype& has predicate, not allowed as index subtype",
+               Index, Etype (Index));
+         end if;
+
+         --  Move to next index
+
          Next_Index (Index);
          Nb_Index := Nb_Index + 1;
       end loop;
@@ -11332,6 +11343,13 @@ package body Sem_Ch3 is
 
             elsif Base_Type (Entity (S)) /= Base_Type (T) then
                Wrong_Type (S, Base_Type (T));
+
+            --  Check error of subtype with predicate in index constraint
+
+            elsif Has_Predicates (Entity (S)) then
+               Error_Msg_NE
+                 ("subtype& has predicate, not allowed in index consraint",
+                  S, Entity (S));
             end if;
 
             return;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index fe2e197..f585368 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -7824,6 +7824,20 @@ package body Sem_Ch6 is
 
          if Comes_From_Source (S) then
             Check_Synchronized_Overriding (S, Overridden_Subp);
+
+            --  (Ada 2012: AI05-0125-1): If S is a dispatching operation then
+            --  it may have overridden some hidden inherited primitive. Update
+            --  Overriden_Subp to avoid spurious errors when checking the
+            --  overriding indicator.
+
+            if Ada_Version >= Ada_2012
+              and then No (Overridden_Subp)
+              and then Is_Dispatching_Operation (S)
+              and then Is_Overriding_Operation (S)
+            then
+               Overridden_Subp := Overridden_Operation (S);
+            end if;
+
             Check_Overriding_Indicator
               (S, Overridden_Subp, Is_Primitive => Is_Primitive_Subp);
          end if;
diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index e060504..42297a1 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -879,19 +879,36 @@ package body Sem_Ch9 is
       Generate_Definition (Def_Id);
       Tasking_Used := True;
 
+      --  Case of no discrete subtype definition
+
       if No (D_Sdef) then
          Set_Ekind (Def_Id, E_Entry);
+
+      --  Processing for discrete subtype definition present
+
       else
          Enter_Name (Def_Id);
          Set_Ekind (Def_Id, E_Entry_Family);
          Analyze (D_Sdef);
          Make_Index (D_Sdef, N, Def_Id);
+
+         --  Check subtype with predicate in entry family
+
+         if Has_Predicates (Etype (D_Sdef)) then
+            Error_Msg_NE
+              ("subtype& has predicate, not allowed in entry family",
+               D_Sdef, Etype (D_Sdef));
+         end if;
       end if;
 
+      --  Decorate Def_Id
+
       Set_Etype          (Def_Id, Standard_Void_Type);
       Set_Convention     (Def_Id, Convention_Entry);
       Set_Accept_Address (Def_Id, New_Elmt_List);
 
+      --  Process formals
+
       if Present (Formals) then
          Set_Scope (Def_Id, Current_Scope);
          Push_Scope (Def_Id);
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 322e535..774c2af 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -72,6 +72,18 @@ package body Sem_Disp is
    --  (returning the designated tagged type in the case of an access
    --  parameter); otherwise returns empty.
 
+   function Find_Hidden_Overridden_Primitive (S : Entity_Id) return Entity_Id;
+   --  [Ada 2012:AI-0125] Find an inherited hidden primitive of the dispatching
+   --  type of S that has the same name of S, a type-conformant profile, an
+   --  original corresponding operation O that is a primitive of a visible
+   --  ancestor of the dispatching type of S and O is visible at the point of
+   --  of declaration of S. If the entity is found the Alias of S is set to the
+   --  original corresponding operation S and its Overridden_Operation is set
+   --  to the found entity; otherwise return Empty.
+   --
+   --  This routine does not search for non-hidden primitives since they are
+   --  covered by the normal Ada 2005 rules.
+
    -------------------------------
    -- Add_Dispatching_Operation --
    -------------------------------
@@ -741,8 +753,9 @@ package body Sem_Disp is
 
    procedure Check_Dispatching_Operation (Subp, Old_Subp : Entity_Id) is
       Tagged_Type            : Entity_Id;
-      Has_Dispatching_Parent : Boolean := False;
-      Body_Is_Last_Primitive : Boolean := False;
+      Has_Dispatching_Parent : Boolean   := False;
+      Body_Is_Last_Primitive : Boolean   := False;
+      Ovr_Subp               : Entity_Id := Empty;
 
    begin
       if not Ekind_In (Subp, E_Procedure, E_Function) then
@@ -1078,14 +1091,25 @@ package body Sem_Disp is
 
       Check_Controlling_Formals (Tagged_Type, Subp);
 
+      Ovr_Subp := Old_Subp;
+
+      --  [Ada 2012:AI-0125]: Search for inherited hidden primitive that may be
+      --  overridden by Subp
+
+      if No (Ovr_Subp)
+        and then Ada_Version >= Ada_2012
+      then
+         Ovr_Subp := Find_Hidden_Overridden_Primitive (Subp);
+      end if;
+
       --  Now it should be a correct primitive operation, put it in the list
 
-      if Present (Old_Subp) then
+      if Present (Ovr_Subp) then
 
          --  If the type has interfaces we complete this check after we set
          --  attribute Is_Dispatching_Operation.
 
-         Check_Subtype_Conformant (Subp, Old_Subp);
+         Check_Subtype_Conformant (Subp, Ovr_Subp);
 
          if (Chars (Subp) = Name_Initialize
            or else Chars (Subp) = Name_Adjust
@@ -1114,7 +1138,7 @@ package body Sem_Disp is
             end if;
 
          else
-            Override_Dispatching_Operation (Tagged_Type, Old_Subp, Subp);
+            Override_Dispatching_Operation (Tagged_Type, Ovr_Subp, Subp);
             Set_Is_Overriding_Operation (Subp);
 
             --  Ada 2005 (AI-251): In case of late overriding of a primitive
@@ -1183,7 +1207,7 @@ package body Sem_Disp is
       --  subtype conformance against all the interfaces covered by this
       --  primitive.
 
-      if Present (Old_Subp)
+      if Present (Ovr_Subp)
         and then Has_Interfaces (Tagged_Type)
       then
          declare
@@ -1649,6 +1673,89 @@ package body Sem_Disp is
       return Empty;
    end Find_Dispatching_Type;
 
+   --------------------------------------
+   -- Find_Hidden_Overridden_Primitive --
+   --------------------------------------
+
+   function Find_Hidden_Overridden_Primitive (S : Entity_Id) return Entity_Id
+   is
+      Tag_Typ   : constant Entity_Id := Find_Dispatching_Type (S);
+      Elmt      : Elmt_Id;
+      Orig_Prim : Entity_Id;
+      Prim      : Entity_Id;
+      Vis_List  : Elist_Id;
+
+   begin
+      --  This Ada 2012 rule is valid only for type extensions or private
+      --  extensions
+
+      if No (Tag_Typ)
+        or else not Is_Record_Type (Tag_Typ)
+        or else Etype (Tag_Typ) = Tag_Typ
+      then
+         return Empty;
+      end if;
+
+      --  Collect the list of visible ancestor of the tagged type
+
+      Vis_List := Visible_Ancestors (Tag_Typ);
+
+      Elmt := First_Elmt (Primitive_Operations (Tag_Typ));
+      while Present (Elmt) loop
+         Prim := Node (Elmt);
+
+         --  Find an inherited hidden dispatching primitive with the name of S
+         --  and a type-conformant profile
+
+         if Present (Alias (Prim))
+           and then Is_Hidden (Alias (Prim))
+           and then Find_Dispatching_Type (Alias (Prim)) /= Tag_Typ
+           and then Primitive_Names_Match (S, Prim)
+           and then Type_Conformant (S, Prim)
+         then
+            declare
+               Vis_Ancestor : Elmt_Id;
+               Elmt         : Elmt_Id;
+
+            begin
+               --  The original corresponding operation of Prim must be an
+               --  operation of a visible ancestor of the dispatching type
+               --  of S, and the original corresponding operation of S2 must
+               --  be visible.
+
+               Orig_Prim := Original_Corresponding_Operation (Prim);
+
+               if Orig_Prim /= Prim
+                 and then Is_Immediately_Visible (Orig_Prim)
+               then
+                  Vis_Ancestor := First_Elmt (Vis_List);
+
+                  while Present (Vis_Ancestor) loop
+                     Elmt :=
+                       First_Elmt (Primitive_Operations (Node (Vis_Ancestor)));
+                     while Present (Elmt) loop
+                        if Node (Elmt) = Orig_Prim then
+                           Set_Overridden_Operation (S, Prim);
+                           Set_Alias (Prim, Orig_Prim);
+
+                           return Prim;
+                        end if;
+
+                        Next_Elmt (Elmt);
+                     end loop;
+
+                     Next_Elmt (Vis_Ancestor);
+                  end loop;
+               end if;
+            end;
+         end if;
+
+         Next_Elmt (Elmt);
+      end loop;
+
+      return Empty;
+   end Find_Hidden_Overridden_Primitive;
+
    ---------------------------------------
    -- Find_Primitive_Covering_Interface --
    ---------------------------------------
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 7c823a8..6df4741 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -8478,7 +8478,16 @@ package body Sem_Res is
 
       Set_Slice_Subtype (N);
 
-      if Nkind (Drange) = N_Range then
+      --  Check bad use of type with predicates
+
+      if Has_Predicates (Etype (Drange)) then
+         Error_Msg_NE
+           ("subtype& has predicate, not allowed in slice",
+            Drange, Etype (Drange));
+
+      --  Otherwise here is where we check suspicious indexes
+
+      elsif Nkind (Drange) = N_Range then
          Warn_On_Suspicious_Index (Name, Low_Bound  (Drange));
          Warn_On_Suspicious_Index (Name, High_Bound (Drange));
       end if;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index ba4d37d..676051d 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -1679,6 +1679,44 @@ package body Sem_Util is
       end loop;
    end Collect_Interfaces_Info;
 
+   ---------------------
+   -- Collect_Parents --
+   ---------------------
+
+   procedure Collect_Parents
+     (T             : Entity_Id;
+      List          : out Elist_Id;
+      Use_Full_View : Boolean := True)
+   is
+      Current_Typ : Entity_Id := T;
+      Parent_Typ  : Entity_Id;
+
+   begin
+      List := New_Elmt_List;
+
+      --  No action if the if the type has no parents
+
+      if T = Etype (T) then
+         return;
+      end if;
+
+      loop
+         Parent_Typ := Etype (Current_Typ);
+
+         if Is_Private_Type (Parent_Typ)
+           and then Present (Full_View (Parent_Typ))
+           and then Use_Full_View
+         then
+            Parent_Typ := Full_View (Base_Type (Parent_Typ));
+         end if;
+
+         Append_Elmt (Parent_Typ, List);
+
+         exit when Parent_Typ = Current_Typ;
+         Current_Typ := Parent_Typ;
+      end loop;
+   end Collect_Parents;
+
    ----------------------------------
    -- Collect_Primitive_Operations --
    ----------------------------------
@@ -9790,6 +9828,38 @@ package body Sem_Util is
       end if;
    end Object_Access_Level;
 
+   --------------------------------------
+   -- Original_Corresponding_Operation --
+   --------------------------------------
+
+   function Original_Corresponding_Operation (S : Entity_Id) return Entity_Id
+   is
+      Typ : constant Entity_Id := Find_Dispatching_Type (S);
+
+   begin
+      --  If S is an inherited primitive S2 the original corresponding
+      --  operation of S is the original corresponding operation of S2
+
+      if Present (Alias (S))
+        and then Find_Dispatching_Type (Alias (S)) /= Typ
+      then
+         return Original_Corresponding_Operation (Alias (S));
+
+      --  If S overrides an inherted subprogram S2 the original corresponding
+      --  operation of S is the original corresponding operation of S2
+
+      elsif Is_Overriding_Operation (S)
+        and then Present (Overridden_Operation (S))
+      then
+         return Original_Corresponding_Operation (Overridden_Operation (S));
+
+      --  otherwise it is S itself
+
+      else
+         return S;
+      end if;
+   end Original_Corresponding_Operation;
+
    -----------------------
    -- Private_Component --
    -----------------------
@@ -11387,6 +11457,47 @@ package body Sem_Util is
       end if;
    end Unqualify;
 
+   -----------------------
+   -- Visible_Ancestors --
+   -----------------------
+
+   function Visible_Ancestors (Typ : Entity_Id) return Elist_Id is
+      List_1 : Elist_Id;
+      List_2 : Elist_Id;
+      Elmt   : Elmt_Id;
+
+   begin
+      pragma Assert (Is_Record_Type (Typ)
+        and then Is_Tagged_Type (Typ));
+
+      --  Collect all the parents and progenitors of Typ. If the full-view of
+      --  private parents and progenitors is available then it is used to
+      --  generate the list of visible ancestors; otherwise their partial
+      --  view is added to the resulting list.
+
+      Collect_Parents
+        (T               => Typ,
+         List            => List_1,
+         Use_Full_View   => True);
+
+      Collect_Interfaces
+        (T               => Typ,
+         Ifaces_List     => List_2,
+         Exclude_Parents => True,
+         Use_Full_View   => True);
+
+      --  Join the two lists. Avoid duplications because an interface may
+      --  simultaneously be parent and progenitor of a type.
+
+      Elmt := First_Elmt (List_2);
+      while Present (Elmt) loop
+         Append_Unique_Elmt (Node (Elmt), List_1);
+         Next_Elmt (Elmt);
+      end loop;
+
+      return List_1;
+   end Visible_Ancestors;
+
    ----------------------
    -- Within_Init_Proc --
    ----------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 9c8bdd1..ec33099 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -197,6 +197,13 @@ package Sem_Util is
    --  of elements, and elements at the same position on these tables provide
    --  information on the same interface type.
 
+   procedure Collect_Parents
+     (T             : Entity_Id;
+      List          : out Elist_Id;
+      Use_Full_View : Boolean := True);
+   --  Collect all the parents of Typ. Use_Full_View is used to collect them
+   --  using the full-view of private parents (if available).
+
    function Collect_Primitive_Operations (T : Entity_Id) return Elist_Id;
    --  Called upon type derivation and extension. We scan the declarative part
    --  in which the type appears, and collect subprograms that have one
@@ -1052,6 +1059,12 @@ package Sem_Util is
    --  (e.g. target of assignment, or out parameter), and to False if the
    --  modification is only potential (e.g. address of entity taken).
 
+   function Original_Corresponding_Operation (S : Entity_Id) return Entity_Id;
+   --  [Ada 2012: AI05-0125-1]: If S is an inherited dispatching primitive S2,
+   --  or overrides an inherited dispatching primitive S2, the original
+   --  corresponding operation of S is the original corresponding operation of
+   --  S2. Otherwise, it is S itself.
+
    function Object_Access_Level (Obj : Node_Id) return Uint;
    --  Return the accessibility level of the view of the object Obj.
    --  For convenience, qualified expressions applied to object names
@@ -1290,6 +1303,13 @@ package Sem_Util is
    --  Removes any qualifications from Expr. For example, for T1'(T2'(X)), this
    --  returns X. If Expr is not a qualified expression, returns Expr.
 
+   function Visible_Ancestors (Typ : Entity_Id) return Elist_Id;
+   --  [Ada 2012:AI-0125-1]: Collect all the visible parents and progenitors
+   --  of a type extension or private extension declaration. If the full-view
+   --  of private parents and progenitors is available then it is used to
+   --  generate the list of visible ancestors; otherwise their partial
+   --  view is added to the resulting list.
+
    function Within_Init_Proc return Boolean;
    --  Determines if Current_Scope is within an init proc