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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 992b1e0b6a4a20816e64539f494c2a8c354434f8..929fc118d594165f58f74c12a47758e6c1bf0f3c 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 0384d370da258857c93dbb71517d05287fa41dc2..bf114832f690c7ec7f8ebe2e8bbf432799875a29 100644 (file)
--- 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;
 }
+\f
+/* 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 41488df50db99ad49033076bf2e5780a44b84b5c..8842321cfaeab83b4e8fb641baa631e92c637ca9 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gnat.dg/subp_elim_errors.adb b/gcc/testsuite/gnat.dg/subp_elim_errors.adb
new file mode 100644 (file)
index 0000000..669e877
--- /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 (file)
index 0000000..d42f1b2
--- /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;