From 51b42ffa5ee75a45b9c708f30ed49b33df33a3c3 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 20 Apr 2016 12:49:24 +0200 Subject: [PATCH] [multiple changes] 2016-04-20 Bob Duff * 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 * 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 --- gcc/ada/ChangeLog | 21 +++++++ gcc/ada/exp_ch6.adb | 60 +----------------- gcc/ada/exp_util.adb | 58 +++++++++++++++++ gcc/ada/exp_util.ads | 4 ++ gcc/ada/freeze.adb | 11 ++++ gcc/ada/sem_ch6.adb | 147 +++++++++++++++++++++++++++++++++++++++---- gcc/ada/sem_util.adb | 19 +++--- 7 files changed, 241 insertions(+), 79 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b849645a49d..e62507ee3a0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2016-04-20 Bob Duff + + * 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 + + * 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 * 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 ea8bed4289c..54f4d029a97 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 8ffbfa31bf0..0c13befd92b 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 1357b3b1a97..5a93ca41b34 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 f23e168bd22..0ea2e1fdd82 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 a0d5b8e2ada..c2705170ca1 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 eaa2429c174..eb3eed56991 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; -- 2.30.2