[multiple changes]

2014-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch8.adb (Build_Class_Wide_Wrapper): Handle various special
	cases related to equality.  Remove the special processing
	for dispatching abstract subprograms as it is not needed.
	(Interpretation_Error): Add a specialized error message for
	predefined operators.
	(Is_Intrinsic_Equality): New routine.
	(Is_Suitable_Candidate): New routine.

2014-08-04  Gary Dismukes  <dismukes@adacore.com>

	* checks.adb: Minor comment reformatting.

2014-08-04  Ed Schonberg  <schonberg@adacore.com>

	* restrict.adb (Check_Restriction): For checked max_parameter
	restrictions reset Violated flag, so that subsequent violations
	are properly detected.

2014-08-04  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb (Check_Initialization): Fix bad test of GNATprove
	mode.
	(Process_Discriminants): Fix bad test of GNATprove mode

2014-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch12.adb (Instantiate_Formal_Subprogram):
	Move variable to their own section. Propagate the source
	location of a formal parameter to the corresponding formal of
	the subprogram renaming declaration. Code reformatting.

From-SVN: r213533

6 files changed, 173 insertions, 89 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bcbe25d..a979ec7 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,36 @@
+2014-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch8.adb (Build_Class_Wide_Wrapper): Handle various special
+	cases related to equality.  Remove the special processing
+	for dispatching abstract subprograms as it is not needed.
+	(Interpretation_Error): Add a specialized error message for
+	predefined operators.
+	(Is_Intrinsic_Equality): New routine.
+	(Is_Suitable_Candidate): New routine.
+
+2014-08-04  Gary Dismukes  <dismukes@adacore.com>
+
+	* checks.adb: Minor comment reformatting.
+
+2014-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* restrict.adb (Check_Restriction): For checked max_parameter
+	restrictions reset Violated flag, so that subsequent violations
+	are properly detected.
+
+2014-08-04  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch3.adb (Check_Initialization): Fix bad test of GNATprove
+	mode.
+	(Process_Discriminants): Fix bad test of GNATprove mode
+
+2014-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch12.adb (Instantiate_Formal_Subprogram):
+	Move variable to their own section. Propagate the source
+	location of a formal parameter to the corresponding formal of
+	the subprogram renaming declaration. Code reformatting.
+
 2014-08-04  Arnaud Charlet  <charlet@adacore.com>
 
 	* g-trasym-vms-ia64.adb, g-trasym-vms-alpha.adb: Removed.
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index bab3ba7..f41df54 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -6407,25 +6407,24 @@ package body Checks is
       --  a temporary. Then check the converted value against the range of the
       --  target subtype.
 
-      procedure Convert_And_Check_Range is
-         --  To what does the following comment belong???
-         --  We make a temporary to hold the value of the converted value
-         --  (converted to the base type), and then we will do the test against
-         --  this temporary.
-         --
-         --     Tnn : constant Target_Base_Type := Target_Base_Type (N);
-         --     [constraint_error when Tnn not in Target_Type]
-         --
-         --  The conversion itself is replaced by an occurrence of Tnn
+      -----------------------------
+      -- Convert_And_Check_Range --
+      -----------------------------
 
+      procedure Convert_And_Check_Range is
          Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N);
 
-         --  To what does the following comment belong???
-         --  Follow the conversion with the explicit range check. Note that we
-         --  suppress checks for this code, since we don't want a recursive
+      begin
+         --  We make a temporary to hold the value of the converted value
+         --  (converted to the base type), and then do the test against this
+         --  temporary. The conversion itself is replaced by an occurrence of
+         --  Tnn and followed by the explicit range check. Note that checks
+         --  are suppressed for this code, since we don't want a recursive
          --  range check popping up.
 
-      begin
+         --     Tnn : constant Target_Base_Type := Target_Base_Type (N);
+         --     [constraint_error when Tnn not in Target_Type]
+
          Insert_Actions (N, New_List (
            Make_Object_Declaration (Loc,
              Defining_Identifier => Tnn,
diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index ff44e6f..9b8e2c6 100644
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -562,6 +562,7 @@ package body Restrict is
 
       if R in Checked_Max_Parameter_Restrictions then
          Restrictions.Count (R) := 0;
+         Restrictions.Violated (R) := False;
       end if;
    end Check_Restriction;
 
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 6bcc3a1..ee40fc8 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -9454,14 +9454,10 @@ package body Sem_Ch12 is
       Actual          : Node_Id;
       Analyzed_Formal : Node_Id) return Node_Id
    is
-      Loc        : Source_Ptr;
-      Formal_Sub : constant Entity_Id :=
-                     Defining_Unit_Name (Specification (Formal));
       Analyzed_S : constant Entity_Id :=
                      Defining_Unit_Name (Specification (Analyzed_Formal));
-      Decl_Node  : Node_Id;
-      Nam        : Node_Id;
-      New_Spec   : Node_Id;
+      Formal_Sub : constant Entity_Id :=
+                     Defining_Unit_Name (Specification (Formal));
 
       function From_Parent_Scope (Subp : Entity_Id) return Boolean;
       --  If the generic is a child unit, the parent has been installed on the
@@ -9528,9 +9524,15 @@ package body Sem_Ch12 is
            ("expect subprogram or entry name in instantiation of&",
             Instantiation_Node, Formal_Sub);
          Abandon_Instantiation (Instantiation_Node);
-
       end Valid_Actual_Subprogram;
 
+      --  Local variables
+
+      Decl_Node  : Node_Id;
+      Loc        : Source_Ptr;
+      Nam        : Node_Id;
+      New_Spec   : Node_Id;
+
    --  Start of processing for Instantiate_Formal_Subprogram
 
    begin
@@ -9547,18 +9549,21 @@ package body Sem_Ch12 is
       Set_Defining_Unit_Name
         (New_Spec, Make_Defining_Identifier (Loc, Chars (Formal_Sub)));
 
-      --  Create new entities for the each of the formals in the
-      --  specification of the renaming declaration built for the actual.
+      --  Create new entities for the each of the formals in the specification
+      --  of the renaming declaration built for the actual.
 
       if Present (Parameter_Specifications (New_Spec)) then
          declare
-            F : Node_Id;
+            F    : Node_Id;
+            F_Id : Entity_Id;
+
          begin
             F := First (Parameter_Specifications (New_Spec));
             while Present (F) loop
+               F_Id := Defining_Identifier (F);
+
                Set_Defining_Identifier (F,
-                  Make_Defining_Identifier (Sloc (F),
-                    Chars => Chars (Defining_Identifier (F))));
+                  Make_Defining_Identifier (Sloc (F_Id), Chars (F_Id)));
                Next (F);
             end loop;
          end;
@@ -9607,9 +9612,10 @@ package body Sem_Ch12 is
          --  identifier or operator with the same name as the formal.
 
          if Nkind (Formal_Sub) = N_Defining_Operator_Symbol then
-            Nam := Make_Operator_Symbol (Loc,
-              Chars =>  Chars (Formal_Sub),
-              Strval => No_String);
+            Nam :=
+              Make_Operator_Symbol (Loc,
+                Chars  => Chars (Formal_Sub),
+                Strval => No_String);
          else
             Nam := Make_Identifier (Loc, Chars (Formal_Sub));
          end if;
@@ -9656,9 +9662,7 @@ package body Sem_Ch12 is
       --  instance. If overloaded, it will be resolved when analyzing the
       --  renaming declaration.
 
-      if Box_Present (Formal)
-        and then No (Actual)
-      then
+      if Box_Present (Formal) and then No (Actual) then
          Analyze (Nam);
 
          if Is_Child_Unit (Scope (Analyzed_S))
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index ce46257..f498303 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -10377,7 +10377,7 @@ package body Sem_Ch3 is
       --  In gnatc or gnatprove mode, make sure set Do_Range_Check flag gets
       --  set unless we can be sure that no range check is required.
 
-      if (not Expander_Active and not GNATprove_Mode)
+      if (GNATprove_Mode or not Expander_Active)
         and then Is_Scalar_Type (T)
         and then not Is_In_Range (Exp, T, Assume_Valid => True)
       then
@@ -18092,7 +18092,7 @@ package body Sem_Ch3 is
             --  In gnatc or gnatprove mode, make sure set Do_Range_Check flag
             --  gets set unless we can be sure that no range check is required.
 
-            if (not Expander_Active and not GNATprove_Mode)
+            if (GNATprove_Mode or not Expander_Active)
               and then not
                 Is_In_Range
                   (Expression (Discr), Discr_Type, Assume_Valid => True)
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 4a5bafc..97518b3 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -1918,6 +1918,14 @@ package body Sem_Ch8 is
          --  Emit a continuation error message suggesting subprogram Subp_Id as
          --  a possible interpretation.
 
+         function Is_Intrinsic_Equality (Subp_Id : Entity_Id) return Boolean;
+         --  Determine whether subprogram Subp_Id denotes the intrinsic "="
+         --  operator.
+
+         function Is_Suitable_Candidate (Subp_Id : Entity_Id) return Boolean;
+         --  Determine whether subprogram Subp_Id is a suitable candidate for
+         --  the role of a wrapped subprogram.
+
          ----------------
          -- Build_Call --
          ----------------
@@ -2087,25 +2095,70 @@ package body Sem_Ch8 is
          procedure Interpretation_Error (Subp_Id : Entity_Id) is
          begin
             Error_Msg_Sloc := Sloc (Subp_Id);
-            Error_Msg_NE
-              ("\\possible interpretation: & defined #", Spec, Formal_Spec);
+
+            if Is_Internal (Subp_Id) then
+               Error_Msg_NE
+                 ("\\possible interpretation: predefined & #",
+                  Spec, Formal_Spec);
+            else
+               Error_Msg_NE
+                 ("\\possible interpretation: & defined #", Spec, Formal_Spec);
+            end if;
          end Interpretation_Error;
 
+         ---------------------------
+         -- Is_Intrinsic_Equality --
+         ---------------------------
+
+         function Is_Intrinsic_Equality (Subp_Id : Entity_Id) return Boolean is
+         begin
+            return
+              Ekind (Subp_Id) = E_Operator
+                and then Chars (Subp_Id) = Name_Op_Eq
+                and then Is_Intrinsic_Subprogram (Subp_Id);
+         end Is_Intrinsic_Equality;
+
+         ---------------------------
+         -- Is_Suitable_Candidate --
+         ---------------------------
+
+         function Is_Suitable_Candidate (Subp_Id : Entity_Id) return Boolean is
+         begin
+            if No (Subp_Id) then
+               return False;
+
+            --  An intrinsic subprogram is never a good candidate. This is an
+            --  indication of a missing primitive, either defined directly or
+            --  inherited from a parent tagged type.
+
+            elsif Is_Intrinsic_Subprogram (Subp_Id) then
+               return False;
+
+            else
+               return True;
+            end if;
+         end Is_Suitable_Candidate;
+
          --  Local variables
 
          Actual_Typ : Entity_Id := Empty;
          --  The actual class-wide type for Formal_Typ
 
+         CW_Prim_OK : Boolean;
          CW_Prim_Op : Entity_Id;
-         --  The class-wide primitive (if any) which corresponds to the renamed
-         --  generic formal subprogram.
+         --  The class-wide subprogram (if available) which corresponds to the
+         --  renamed generic formal subprogram.
 
          Formal_Typ : Entity_Id := Empty;
-         --  The generic formal type (if any) with unknown discriminants
+         --  The generic formal type with unknown discriminants
 
+         Root_Prim_OK : Boolean;
          Root_Prim_Op : Entity_Id;
-         --  The root type primitive (if any) which corresponds to the renamed
-         --  generic formal subprogram.
+         --  The root type primitive (if available) which corresponds to the
+         --  renamed generic formal subprogram.
+
+         Root_Typ : Entity_Id := Empty;
+         --  The root type of Actual_Typ
 
          Body_Decl : Node_Id;
          Formal    : Node_Id;
@@ -2128,10 +2181,19 @@ package body Sem_Ch8 is
          end if;
 
          --  Analyze the renamed name, but do not resolve it. The resolution is
-         --  completed once a suitable primitive is found.
+         --  completed once a suitable subprogram is found.
 
          Analyze (Nam);
 
+         --  When the renamed name denotes the intrinsic operator equals, the
+         --  name must be treated as overloaded. This allows for a potential
+         --  match against the root type's predefined equality function.
+
+         if Is_Intrinsic_Equality (Entity (Nam)) then
+            Set_Is_Overloaded (Nam);
+            Collect_Interps   (Nam);
+         end if;
+
          --  Step 1: Find the generic formal type with unknown discriminants
          --  and its corresponding class-wide actual type from the renamed
          --  generic formal subprogram.
@@ -2144,6 +2206,7 @@ package body Sem_Ch8 is
             then
                Formal_Typ := Etype (Formal);
                Actual_Typ := Get_Instance_Of (Formal_Typ);
+               Root_Typ   := Etype (Actual_Typ);
                exit;
             end if;
 
@@ -2157,13 +2220,15 @@ package body Sem_Ch8 is
 
          pragma Assert (Present (Formal_Typ));
 
-         --  Step 2: Find the proper primitive which corresponds to the renamed
-         --  generic formal subprogram.
+         --  Step 2: Find the proper class-wide subprogram or primitive which
+         --  corresponds to the renamed generic formal subprogram.
 
          CW_Prim_Op   := Find_Primitive (Actual_Typ);
-         Root_Prim_Op := Find_Primitive (Etype (Actual_Typ));
+         CW_Prim_OK   := Is_Suitable_Candidate (CW_Prim_Op);
+         Root_Prim_Op := Find_Primitive (Root_Typ);
+         Root_Prim_OK := Is_Suitable_Candidate (Root_Prim_Op);
 
-         --  The class-wide actual type has two primitives which correspond to
+         --  The class-wide actual type has two subprograms which correspond to
          --  the renamed generic formal subprogram:
 
          --    with procedure Prim_Op (Param : Formal_Typ);
@@ -2171,72 +2236,54 @@ package body Sem_Ch8 is
          --    procedure Prim_Op (Param : Actual_Typ);  --  may be inherited
          --    procedure Prim_Op (Param : Actual_Typ'Class);
 
-         --  Even though the declaration of the two primitives is legal, a call
-         --  to either one is ambiguous and therefore illegal.
+         --  Even though the declaration of the two subprograms is legal, a
+         --  call to either one is ambiguous and therefore illegal.
 
-         if Present (CW_Prim_Op) and then Present (Root_Prim_Op) then
+         if CW_Prim_OK and Root_Prim_OK then
 
-            --  Deal with abstract primitives
+            --  A user-defined primitive has precedence over a predefined one
 
-            if Is_Abstract_Subprogram (CW_Prim_Op)
-              or else Is_Abstract_Subprogram (Root_Prim_Op)
+            if Is_Internal (CW_Prim_Op)
+              and then not Is_Internal (Root_Prim_Op)
             then
-               --  An abstract subprogram cannot act as a generic actual, but
-               --  the partial parameterization of the instance may hide the
-               --  true nature of the actual. Emit an error when both options
-               --  are abstract.
-
-               if Is_Abstract_Subprogram (CW_Prim_Op)
-                 and then Is_Abstract_Subprogram (Root_Prim_Op)
-               then
-                  Error_Msg_NE
-                    ("abstract subprogram not allowed as generic actual",
-                     Spec, Formal_Spec);
-                  Interpretation_Error (CW_Prim_Op);
-                  Interpretation_Error (Root_Prim_Op);
-                  return;
-
-               --  Otherwise choose the non-abstract version
-
-               elsif Is_Abstract_Subprogram (Root_Prim_Op) then
-                  Prim_Op := CW_Prim_Op;
-
-               else pragma Assert (Is_Abstract_Subprogram (CW_Prim_Op));
-                  Prim_Op := Root_Prim_Op;
-               end if;
-
-            --  If one of the candidate primitives is intrinsic, choose the
-            --  other (which may also be intrinsic). Preference is given to
-            --  the primitive of the root type.
-
-            elsif Is_Intrinsic_Subprogram (CW_Prim_Op) then
                Prim_Op := Root_Prim_Op;
 
-            elsif Is_Intrinsic_Subprogram (Root_Prim_Op) then
+            elsif Is_Internal (Root_Prim_Op)
+              and then not Is_Internal (CW_Prim_Op)
+            then
                Prim_Op := CW_Prim_Op;
 
             elsif CW_Prim_Op = Root_Prim_Op then
                Prim_Op := Root_Prim_Op;
 
-            --  Otherwise there are two perfectly good candidates which satisfy
-            --  the profile of the renamed generic formal subprogram.
+            --  Otherwise both candidate subprograms are user-defined and
+            --  ambiguous.
 
             else
                Error_Msg_NE
                  ("ambiguous actual for generic subprogram &",
-                   Spec, Formal_Spec);
-               Interpretation_Error (CW_Prim_Op);
+                  Spec, Formal_Spec);
                Interpretation_Error (Root_Prim_Op);
+               Interpretation_Error (CW_Prim_Op);
                return;
             end if;
 
-         elsif Present (CW_Prim_Op) then
+         elsif CW_Prim_OK and not Root_Prim_OK then
             Prim_Op := CW_Prim_Op;
 
-         elsif Present (Root_Prim_Op) then
+         elsif not CW_Prim_OK and Root_Prim_OK then
+            Prim_Op := Root_Prim_Op;
+
+         --  An intrinsic equality may act as a suitable candidate in the case
+         --  of a null type extension where the parent's equality is hidden. A
+         --  call to an intrinsic equality is expanded as dispatching.
+
+         elsif Present (Root_Prim_Op)
+           and then Is_Intrinsic_Equality (Root_Prim_Op)
+         then
             Prim_Op := Root_Prim_Op;
 
-         --  Otherwise there are no candidate primitives. Let the caller
+         --  Otherwise there are no candidate subprograms. Let the caller
          --  diagnose the error.
 
          else