procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
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
This commit is contained in:
Arnaud Charlet 2016-04-20 12:49:24 +02:00
parent f73dc37f75
commit 51b42ffa5e
7 changed files with 241 additions and 79 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
gcc/ada/ChangeLog
View file

@ -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):

60
gcc/ada/exp_ch6.adb
View file

@ -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;

58
gcc/ada/exp_util.adb
View file

@ -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 --
------------------------

4
gcc/ada/exp_util.ads
View file

@ -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

11
gcc/ada/freeze.adb
View file

@ -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;
----------------------

147
gcc/ada/sem_ch6.adb
View file

@ -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;

19
gcc/ada/sem_util.adb
View file

@ -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;