[multiple changes]

2016-04-20  Bob Duff  <duff@adacore.com>

	* sem_ch6.adb (Enter_Overloaded_Entity): Do not warn about
	hiding unless we're actually hiding something. The previous
	code would (for example) warn about a "<" on a record type
	because it incorrectly thought it was hiding the "<" on Boolean
	in Standard. We need to check that the homonym S is in fact a
	homograph of a predefined operator.

2016-04-20  Ed Schonberg  <schonberg@adacore.com>

	* exp_util.ads, exp_util.adb (Build_Procedure_Form): Moved here
	from exp_ch6.adb, for use in SPARK_To_C mode when creating the
	procedure equivalent to a function returning an array, when this
	construction is deferred to the freeze point of the function.
	* sem_util.adb (Is_Unchecked_Conversion_Instance): Include a
	function that renames an instance of Unchecked_Conversion.
	* freeze.adb (Freeze_Subprogram): Generate the proper procedure
	declaration for a function returning an array.
	* exp_ch6.adb (Build_Procedure_Form): Moved to exp_util.

From-SVN: r235266

7 files changed, 241 insertions, 79 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b849645..e62507e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,24 @@
+2016-04-20  Bob Duff  <duff@adacore.com>
+
+	* sem_ch6.adb (Enter_Overloaded_Entity): Do not warn about
+	hiding unless we're actually hiding something. The previous
+	code would (for example) warn about a "<" on a record type
+	because it incorrectly thought it was hiding the "<" on Boolean
+	in Standard. We need to check that the homonym S is in fact a
+	homograph of a predefined operator.
+
+2016-04-20  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_util.ads, exp_util.adb (Build_Procedure_Form): Moved here
+	from exp_ch6.adb, for use in SPARK_To_C mode when creating the
+	procedure equivalent to a function returning an array, when this
+	construction is deferred to the freeze point of the function.
+	* sem_util.adb (Is_Unchecked_Conversion_Instance): Include a
+	function that renames an instance of Unchecked_Conversion.
+	* freeze.adb (Freeze_Subprogram): Generate the proper procedure
+	declaration for a function returning an array.
+	* exp_ch6.adb (Build_Procedure_Form): Moved to exp_util.
+
 2016-04-20  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_util.ads, sem_util.adb (Is_Expanded_Priority_Attribute):
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index ea8bed4..54f4d02 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5557,64 +5557,6 @@ package body Exp_Ch6 is
       Loc  : constant Source_Ptr := Sloc (N);
       Subp : constant Entity_Id  := Defining_Entity (N);
 
-      procedure Build_Procedure_Form;
-      --  Create a procedure declaration which emulates the behavior of
-      --  function Subp, for C-compatible generation.
-
-      --------------------------
-      -- Build_Procedure_Form --
-      --------------------------
-
-      procedure Build_Procedure_Form is
-         Func_Formal  : Entity_Id;
-         Proc_Formals : List_Id;
-
-      begin
-         Proc_Formals := New_List;
-
-         --  Create a list of formal parameters with the same types as the
-         --  function.
-
-         Func_Formal := First_Formal (Subp);
-         while Present (Func_Formal) loop
-            Append_To (Proc_Formals,
-              Make_Parameter_Specification (Loc,
-                Defining_Identifier =>
-                  Make_Defining_Identifier (Loc, Chars (Func_Formal)),
-                Parameter_Type      =>
-                  New_Occurrence_Of (Etype (Func_Formal), Loc)));
-
-            Next_Formal (Func_Formal);
-         end loop;
-
-         --  Add an extra out parameter to carry the function result
-
-         Name_Len := 6;
-         Name_Buffer (1 .. Name_Len) := "RESULT";
-         Append_To (Proc_Formals,
-           Make_Parameter_Specification (Loc,
-             Defining_Identifier =>
-               Make_Defining_Identifier (Loc, Chars => Name_Find),
-             Out_Present         => True,
-             Parameter_Type      => New_Occurrence_Of (Etype (Subp), Loc)));
-
-         --  The new procedure declaration is inserted immediately after the
-         --  function declaration. The processing in Build_Procedure_Body_Form
-         --  relies on this order.
-
-         Insert_After_And_Analyze (N,
-           Make_Subprogram_Declaration (Loc,
-             Specification =>
-               Make_Procedure_Specification (Loc,
-                 Defining_Unit_Name       =>
-                   Make_Defining_Identifier (Loc, Chars (Subp)),
-                 Parameter_Specifications => Proc_Formals)));
-
-         --  Mark the function as having a procedure form
-
-         Set_Rewritten_For_C (Subp);
-      end Build_Procedure_Form;
-
       --  Local variables
 
       Scop      : constant Entity_Id  := Scope (Subp);
@@ -5740,7 +5682,7 @@ package body Exp_Ch6 is
         and then Is_Constrained (Etype (Subp))
         and then not Is_Unchecked_Conversion_Instance (Subp)
       then
-         Build_Procedure_Form;
+         Build_Procedure_Form (N);
       end if;
    end Expand_N_Subprogram_Declaration;
 
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 8ffbfa3..0c13bef 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -919,6 +919,64 @@ package body Exp_Util is
       end;
    end Build_Allocate_Deallocate_Proc;
 
+   --------------------------
+   -- Build_Procedure_Form --
+   --------------------------
+
+   procedure Build_Procedure_Form (N : Node_Id) is
+      Loc          : constant Source_Ptr := Sloc (N);
+      Subp         : constant Entity_Id := Defining_Entity (N);
+
+      Func_Formal  : Entity_Id;
+      Proc_Formals : List_Id;
+
+   begin
+      Proc_Formals := New_List;
+
+      --  Create a list of formal parameters with the same types as the
+      --  function.
+
+      Func_Formal := First_Formal (Subp);
+      while Present (Func_Formal) loop
+         Append_To (Proc_Formals,
+           Make_Parameter_Specification (Loc,
+             Defining_Identifier =>
+
+               Make_Defining_Identifier (Loc, Chars (Func_Formal)),
+             Parameter_Type      =>
+               New_Occurrence_Of (Etype (Func_Formal), Loc)));
+
+         Next_Formal (Func_Formal);
+      end loop;
+
+      --  Add an extra out parameter to carry the function result
+
+      Name_Len := 6;
+      Name_Buffer (1 .. Name_Len) := "RESULT";
+      Append_To (Proc_Formals,
+        Make_Parameter_Specification (Loc,
+          Defining_Identifier =>
+            Make_Defining_Identifier (Loc, Chars => Name_Find),
+          Out_Present         => True,
+          Parameter_Type      => New_Occurrence_Of (Etype (Subp), Loc)));
+
+      --  The new procedure declaration is inserted immediately after the
+      --  function declaration. The processing in Build_Procedure_Body_Form
+      --  relies on this order.
+
+      Insert_After_And_Analyze (Unit_Declaration_Node (Subp),
+        Make_Subprogram_Declaration (Loc,
+          Specification =>
+            Make_Procedure_Specification (Loc,
+              Defining_Unit_Name       =>
+                Make_Defining_Identifier (Loc, Chars (Subp)),
+              Parameter_Specifications => Proc_Formals)));
+
+      --  Mark the function as having a procedure form
+
+      Set_Rewritten_For_C (Subp);
+   end Build_Procedure_Form;
+
    ------------------------
    -- Build_Runtime_Call --
    ------------------------
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 1357b3b..5a93ca4 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -238,6 +238,10 @@ package Exp_Util is
    --  must be a free statement. If flag Is_Allocate is set, the generated
    --  routine is allocate, deallocate otherwise.
 
+   procedure Build_Procedure_Form (N : Node_Id);
+   --  Create a procedure declaration which emulates the behavior of a function
+   --  that returns an array type, for C-compatible generation.
+
    function Build_Runtime_Call (Loc : Source_Ptr; RE : RE_Id) return Node_Id;
    --  Build an N_Procedure_Call_Statement calling the given runtime entity.
    --  The call has no parameters. The first argument provides the location
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index f23e168..0ea2e1f 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -7892,6 +7892,17 @@ package body Freeze is
       then
          Check_Overriding_Indicator (E, Empty, Is_Primitive (E));
       end if;
+
+      if Modify_Tree_For_C
+        and then Nkind (Parent (E)) = N_Function_Specification
+        and then Is_Array_Type (Etype (E))
+        and then Is_Constrained (Etype (E))
+        and then not Is_Unchecked_Conversion_Instance (E)
+        and then not Rewritten_For_C (E)
+      then
+         Build_Procedure_Form (Unit_Declaration_Node (E));
+      end if;
+
    end Freeze_Subprogram;
 
    ----------------------
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index a0d5b8e..c270517 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -7120,9 +7120,126 @@ package body Sem_Ch6 is
    -----------------------------
 
    procedure Enter_Overloaded_Entity (S : Entity_Id) is
+      function Matches_Predefined_Op return Boolean;
+      --  This returns an approximation of whether S matches a predefined
+      --  operator, based on the operator symbol, and the parameter and result
+      --  types. The rules are scattered throughout chapter 4 of the Ada RM.
+
+      ---------------------------
+      -- Matches_Predefined_Op --
+      ---------------------------
+
+      function Matches_Predefined_Op return Boolean is
+         Formal_1    : constant Entity_Id := First_Formal (S);
+         Formal_2    : constant Entity_Id := Next_Formal (Formal_1);
+         Op          : constant Name_Id   := Chars (S);
+         Result_Type : constant Entity_Id := Base_Type (Etype (S));
+         Type_1      : constant Entity_Id := Base_Type (Etype (Formal_1));
+
+      begin
+         --  Binary operator
+
+         if Present (Formal_2) then
+            declare
+               Type_2 : constant Entity_Id := Base_Type (Etype (Formal_2));
+
+            begin
+               --  All but "&" and "**" have same-types parameters
+
+               case Op is
+                  when Name_Op_Concat |
+                       Name_Op_Expon  =>
+                     null;
+
+                  when others =>
+                     if Type_1 /= Type_2 then
+                        return False;
+                     end if;
+               end case;
+
+               --  Check parameter and result types
+
+               case Op is
+                  when Name_Op_And |
+                       Name_Op_Or  |
+                       Name_Op_Xor =>
+                     return
+                       Is_Boolean_Type (Result_Type)
+                         and then Result_Type = Type_1;
+
+                  when Name_Op_Mod |
+                       Name_Op_Rem =>
+                     return
+                       Is_Integer_Type (Result_Type)
+                         and then Result_Type = Type_1;
+
+                  when Name_Op_Add      |
+                       Name_Op_Divide   |
+                       Name_Op_Multiply |
+                       Name_Op_Subtract =>
+                     return
+                       Is_Numeric_Type (Result_Type)
+                         and then Result_Type = Type_1;
+
+                  when Name_Op_Eq |
+                       Name_Op_Ne =>
+                     return
+                       Is_Boolean_Type (Result_Type)
+                         and then not Is_Limited_Type (Type_1);
+
+                  when Name_Op_Ge |
+                       Name_Op_Gt |
+                       Name_Op_Le |
+                       Name_Op_Lt =>
+                     return
+                       Is_Boolean_Type (Result_Type)
+                         and then (Is_Array_Type (Type_1)
+                                    or else Is_Scalar_Type (Type_1));
+
+                  when Name_Op_Concat =>
+                     return Is_Array_Type (Result_Type);
+
+                  when Name_Op_Expon =>
+                     return
+                       (Is_Integer_Type (Result_Type)
+                           or else Is_Floating_Point_Type (Result_Type))
+                         and then Result_Type = Type_1
+                         and then Type_2 = Standard_Integer;
+
+                  when others =>
+                     raise Program_Error;
+               end case;
+            end;
+
+         --  Unary operator
+
+         else
+            case Op is
+               when Name_Op_Abs      |
+                    Name_Op_Add      |
+                    Name_Op_Subtract =>
+                  return
+                    Is_Numeric_Type (Result_Type)
+                      and then Result_Type = Type_1;
+
+               when Name_Op_Not =>
+                  return
+                    Is_Boolean_Type (Result_Type)
+                      and then Result_Type = Type_1;
+
+               when others =>
+                  raise Program_Error;
+            end case;
+         end if;
+      end Matches_Predefined_Op;
+
+      --  Local variables
+
       E   : Entity_Id := Current_Entity_In_Scope (S);
       C_E : Entity_Id := Current_Entity (S);
 
+   --  Start of processing for Enter_Overloaded_Entity
+
    begin
       if Present (E) then
          Set_Has_Homonym (E);
@@ -7193,22 +7310,26 @@ package body Sem_Ch6 is
             --  or S is overriding an implicit inherited subprogram.
 
             if Scope (E) /= Scope (S)
-                  and then (not Is_Overloadable (E)
-                             or else Subtype_Conformant (E, S))
-                  and then (Is_Immediately_Visible (E)
-                              or else
-                            Is_Potentially_Use_Visible (S))
+              and then (not Is_Overloadable (E)
+                         or else Subtype_Conformant (E, S))
+              and then (Is_Immediately_Visible (E)
+                         or else Is_Potentially_Use_Visible (S))
             then
-               if Scope (E) /= Standard_Standard then
+               if Scope (E) = Standard_Standard then
+                  if Nkind (S) = N_Defining_Operator_Symbol
+                    and then Scope (Base_Type (Etype (First_Formal (S)))) /=
+                               Scope (S)
+                    and then Matches_Predefined_Op
+                  then
+                     Error_Msg_N
+                       ("declaration of & hides predefined operator?h?", S);
+                  end if;
+
+               --  E not immediately within Standard
+
+               else
                   Error_Msg_Sloc := Sloc (E);
                   Error_Msg_N ("declaration of & hides one #?h?", S);
-
-               elsif Nkind (S) = N_Defining_Operator_Symbol
-                 and then
-                   Scope (Base_Type (Etype (First_Formal (S)))) /= Scope (S)
-               then
-                  Error_Msg_N
-                    ("declaration of & hides predefined operator?h?", S);
                end if;
             end if;
          end loop;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index eaa2429..eb3eed5 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -14344,7 +14344,8 @@ package body Sem_Util is
 
    begin
       --  Look for a function whose generic parent is the predefined intrinsic
-      --  function Unchecked_Conversion.
+      --  function Unchecked_Conversion, or for one that renames such an
+      --  instance.
 
       if Ekind (Id) = E_Function then
          Par := Parent (Id);
@@ -14352,12 +14353,16 @@ package body Sem_Util is
          if Nkind (Par) = N_Function_Specification then
             Par := Generic_Parent (Par);
 
-            return
-              Present (Par)
-                and then Chars (Par) = Name_Unchecked_Conversion
-                and then Is_Intrinsic_Subprogram (Par)
-                and then Is_Predefined_File_Name
-                           (Unit_File_Name (Get_Source_Unit (Par)));
+            if Present (Par) then
+               return
+                 Chars (Par) = Name_Unchecked_Conversion
+                   and then Is_Intrinsic_Subprogram (Par)
+                   and then Is_Predefined_File_Name
+                              (Unit_File_Name (Get_Source_Unit (Par)));
+            else
+               return Present (Alias (Id))
+                 and then Is_Unchecked_Conversion_Instance (Alias (Id));
+            end if;
          end if;
       end if;