trans.c (check_for_eliminated_entity): New function.

* gcc-interface/trans.c (check_for_eliminated_entity): New function.
	(Attribute_to_gnu): Invoke it for Access- and Address-like attributes.
	(call_to_gnu): Invoke it instead of manually checking.

From-SVN: r145652
This commit is contained in:
Eric Botcazou 2009-04-07 07:36:31 +00:00 committed by Eric Botcazou
parent 3afadac3ca
commit aa1aa786c9
5 changed files with 72 additions and 9 deletions

View File

@ -1,3 +1,9 @@
2009-04-07 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (check_for_eliminated_entity): New function.
(Attribute_to_gnu): Invoke it for Access- and Address-like attributes.
(call_to_gnu): Invoke it instead of manually checking.
2009-04-04 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/utils.c (finish_record_type): Force structural equality

View File

@ -823,6 +823,24 @@ Pragma_to_gnu (Node_Id gnat_node)
return gnu_result;
}
/* Issue an error message if GNAT_NODE references an eliminated entity. */
static void
check_for_eliminated_entity (Node_Id gnat_node)
{
switch (Nkind (gnat_node))
{
case N_Identifier:
case N_Operator_Symbol:
case N_Expanded_Name:
case N_Attribute_Reference:
if (Is_Eliminated (Entity (gnat_node)))
Eliminate_Error_Msg (gnat_node, Entity (gnat_node));
break;
}
}
/* Subroutine of gnat_to_gnu to translate gnat_node, an N_Attribute,
to a GCC tree, which is returned. GNU_RESULT_TYPE_P is a pointer to
where we should place the result type. ATTRIBUTE is the attribute ID. */
@ -963,6 +981,8 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
don't try to build a trampoline. */
if (attribute == Attr_Code_Address)
{
check_for_eliminated_entity (Prefix (gnat_node));
for (gnu_expr = gnu_result;
CONVERT_EXPR_P (gnu_expr);
gnu_expr = TREE_OPERAND (gnu_expr, 0))
@ -977,6 +997,8 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
a useful warning with -Wtrampolines. */
else if (TREE_CODE (TREE_TYPE (gnu_prefix)) == FUNCTION_TYPE)
{
check_for_eliminated_entity (Prefix (gnat_node));
for (gnu_expr = gnu_result;
CONVERT_EXPR_P (gnu_expr);
gnu_expr = TREE_OPERAND (gnu_expr, 0))
@ -2098,15 +2120,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
tree gnu_after_list = NULL_TREE;
tree gnu_subprog_call;
switch (Nkind (Name (gnat_node)))
{
case N_Identifier:
case N_Operator_Symbol:
case N_Expanded_Name:
case N_Attribute_Reference:
if (Is_Eliminated (Entity (Name (gnat_node))))
Eliminate_Error_Msg (gnat_node, Entity (Name (gnat_node)));
}
check_for_eliminated_entity (Name (gnat_node));
gcc_assert (TREE_CODE (gnu_subprog_type) == FUNCTION_TYPE);

View File

@ -1,3 +1,7 @@
2009-04-07 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/subp_elim_errors.ad[sb]: New test.
2009-04-07 Janus Weil <janus@gcc.gnu.org>
PR fortran/38920

View File

@ -0,0 +1,32 @@
-- [ dg-do compile }
with System;
package body Subp_Elim_Errors is
type Acc_Proc is access procedure;
procedure Proc is
begin
null;
end Proc;
procedure Pass_Proc (P : Acc_Proc) is
begin
P.all;
end Pass_Proc;
procedure Pass_Proc (P : System.Address) is
begin
null;
end Pass_Proc;
begin
Proc; -- { dg-error "eliminated" }
Pass_Proc (Proc'Access); -- { dg-error "eliminated" }
Pass_Proc (Proc'Address); -- { dg-error "eliminated" }
Pass_Proc (Proc'Code_Address); -- { dg-error "eliminated" }
end Subp_Elim_Errors;

View File

@ -0,0 +1,7 @@
pragma Eliminate (Subp_Elim_Errors, Proc);
package Subp_Elim_Errors is
procedure Proc;
end Subp_Elim_Errors;