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:
parent
3afadac3ca
commit
aa1aa786c9
@ -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
|
||||
|
@ -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);
|
||||
|
||||
|
@ -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
|
||||
|
32
gcc/testsuite/gnat.dg/subp_elim_errors.adb
Normal file
32
gcc/testsuite/gnat.dg/subp_elim_errors.adb
Normal 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;
|
7
gcc/testsuite/gnat.dg/subp_elim_errors.ads
Normal file
7
gcc/testsuite/gnat.dg/subp_elim_errors.ads
Normal file
@ -0,0 +1,7 @@
|
||||
pragma Eliminate (Subp_Elim_Errors, Proc);
|
||||
|
||||
package Subp_Elim_Errors is
|
||||
|
||||
procedure Proc;
|
||||
|
||||
end Subp_Elim_Errors;
|
Loading…
Reference in New Issue
Block a user