+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):
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);
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;
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 --
------------------------
-- 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
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;
----------------------
-----------------------------
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);
-- 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;
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);
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;
projects / gcc.git / commitdiff