From aa1aa786c994d730eb461c0661e07647f4f2c0f3 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 7 Apr 2009 07:36:31 +0000 Subject: [PATCH] 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 --- gcc/ada/ChangeLog | 6 ++++ gcc/ada/gcc-interface/trans.c | 32 ++++++++++++++++------ gcc/testsuite/ChangeLog | 4 +++ gcc/testsuite/gnat.dg/subp_elim_errors.adb | 32 ++++++++++++++++++++++ gcc/testsuite/gnat.dg/subp_elim_errors.ads | 7 +++++ 5 files changed, 72 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/subp_elim_errors.adb create mode 100644 gcc/testsuite/gnat.dg/subp_elim_errors.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 992b1e0b6a4..929fc118d59 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2009-04-07 Eric Botcazou + + * 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 * gcc-interface/utils.c (finish_record_type): Force structural equality diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 0384d370da2..bf114832f69 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 41488df50db..8842321cfae 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2009-04-07 Eric Botcazou + + * gnat.dg/subp_elim_errors.ad[sb]: New test. + 2009-04-07 Janus Weil PR fortran/38920 diff --git a/gcc/testsuite/gnat.dg/subp_elim_errors.adb b/gcc/testsuite/gnat.dg/subp_elim_errors.adb new file mode 100644 index 00000000000..669e8772117 --- /dev/null +++ b/gcc/testsuite/gnat.dg/subp_elim_errors.adb @@ -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; diff --git a/gcc/testsuite/gnat.dg/subp_elim_errors.ads b/gcc/testsuite/gnat.dg/subp_elim_errors.ads new file mode 100644 index 00000000000..d42f1b204b3 --- /dev/null +++ b/gcc/testsuite/gnat.dg/subp_elim_errors.ads @@ -0,0 +1,7 @@ +pragma Eliminate (Subp_Elim_Errors, Proc); + +package Subp_Elim_Errors is + + procedure Proc; + +end Subp_Elim_Errors;