[Ada] Do not generate debug info for actual subtypes

Message ID 1574689.BLYs4ly5bf@polaris
State New
Headers show
Series
  • [Ada] Do not generate debug info for actual subtypes
Related show

Commit Message

Eric Botcazou July 7, 2018, 10:20 a.m.
These actual subtypes are artificial subtypes generated for parameters whose 
nominal subtype is an unconstrained array type in order to expose the bounds.

There is no point in generating debug info for them so avoid doing it now.

Tested on x86-64/Linux, applied on the mainline.


2018-07-07  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/gigi.h (add_decl_expr): Adjust prototype.
	* gcc-interface/decl.c (gnat_to_gnu_entity): Remove useless test.
	* gcc-interface/trans.c (add_stmt_with_node): Remove exceptions.
	(add_decl_expr): Change type of second parameter and rename it.
	(renaming_from_instantiation_p): New function moved from...
	(set_expr_location_from_node): Test for exceptions here and add one
	for actual subtypes built for unconstrained composite actuals.
	* gcc-interface/utils.c (renaming_from_instantiation_p): ...here.

Patch

Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 262495)
+++ gcc-interface/decl.c	(working copy)
@@ -430,11 +430,10 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	      || Is_Public (gnat_entity));
 
   /* Get the name of the entity and set up the line number and filename of
-     the original definition for use in any decl we make.  Make sure we do not
-     inherit another source location.  */
+     the original definition for use in any decl we make.  Make sure we do
+     not inherit another source location.  */
   gnu_entity_name = get_entity_name (gnat_entity);
-  if (Sloc (gnat_entity) != No_Location
-      && !renaming_from_instantiation_p (gnat_entity))
+  if (!renaming_from_instantiation_p (gnat_entity))
     Sloc_to_locus (Sloc (gnat_entity), &input_location);
 
   /* For cases when we are not defining (i.e., we are referencing from
Index: gcc-interface/gigi.h
===================================================================
--- gcc-interface/gigi.h	(revision 262468)
+++ gcc-interface/gigi.h	(working copy)
@@ -77,9 +77,9 @@  extern tree end_stmt_group (void);
 /* Set the BLOCK node corresponding to the current code group to GNU_BLOCK.  */
 extern void set_block_for_group (tree);
 
-/* Add a declaration statement for GNU_DECL to the current BLOCK_STMT node.
-   Get SLOC from GNAT_ENTITY.  */
-extern void add_decl_expr (tree gnu_decl, Entity_Id gnat_entity);
+/* Add a declaration statement for GNU_DECL to the current statement group.
+   Get the SLOC to be put onto the statement from GNAT_NODE.  */
+extern void add_decl_expr (tree gnu_decl, Node_Id gnat_node);
 
 /* Mark nodes rooted at T with TREE_VISITED and types as having their
    sized gimplified.  We use this to indicate all variable sizes and
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 262496)
+++ gcc-interface/trans.c	(working copy)
@@ -8119,9 +8119,7 @@  add_stmt_force (tree gnu_stmt)
 void
 add_stmt_with_node (tree gnu_stmt, Node_Id gnat_node)
 {
-  /* Do not emit a location for renamings that come from generic instantiation,
-     they are likely to disturb debugging.  */
-  if (Present (gnat_node) && !renaming_from_instantiation_p (gnat_node))
+  if (Present (gnat_node))
     set_expr_location_from_node (gnu_stmt, gnat_node);
   add_stmt (gnu_stmt);
 }
@@ -8137,10 +8135,10 @@  add_stmt_with_node_force (tree gnu_stmt,
 }
 
 /* Add a declaration statement for GNU_DECL to the current statement group.
-   Get SLOC from Entity_Id.  */
+   Get the SLOC to be put onto the statement from GNAT_NODE.  */
 
 void
-add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
+add_decl_expr (tree gnu_decl, Node_Id gnat_node)
 {
   tree type = TREE_TYPE (gnu_decl);
   tree gnu_stmt, gnu_init;
@@ -8179,7 +8177,7 @@  add_decl_expr (tree gnu_decl, Entity_Id
 	MARK_VISITED (TYPE_ADA_SIZE (type));
     }
   else
-    add_stmt_with_node (gnu_stmt, gnat_entity);
+    add_stmt_with_node (gnu_stmt, gnat_node);
 
   /* If this is a variable and an initializer is attached to it, it must be
      valid for the context.  Similar to init_const in create_var_decl.  */
@@ -8203,7 +8201,7 @@  add_decl_expr (tree gnu_decl, Entity_Id
 	gnu_decl = convert (TREE_TYPE (TYPE_FIELDS (type)), gnu_decl);
 
       gnu_stmt = build_binary_op (INIT_EXPR, NULL_TREE, gnu_decl, gnu_init);
-      add_stmt_with_node (gnu_stmt, gnat_entity);
+      add_stmt_with_node (gnu_stmt, gnat_node);
     }
 }
 
@@ -10005,6 +10003,32 @@  Sloc_to_locus (Source_Ptr Sloc, location
   return true;
 }
 
+/* Return whether GNAT_NODE is a defining identifier for a renaming that comes
+   from the parameter association for the instantiation of a generic.  We do
+   not want to emit source location for them: the code generated for their
+   initialization is likely to disturb debugging.  */
+
+bool
+renaming_from_instantiation_p (Node_Id gnat_node)
+{
+  if (Nkind (gnat_node) != N_Defining_Identifier
+      || !Is_Object (gnat_node)
+      || Comes_From_Source (gnat_node)
+      || !Present (Renamed_Object (gnat_node)))
+    return false;
+
+  /* Get the object declaration of the renamed object, if any and if the
+     renamed object is a mere identifier.  */
+  gnat_node = Renamed_Object (gnat_node);
+  if (Nkind (gnat_node) != N_Identifier)
+    return false;
+
+  gnat_node = Parent (Entity (gnat_node));
+  return (Present (gnat_node)
+	  && Nkind (gnat_node) == N_Object_Declaration
+	  && Present (Corresponding_Generic_Association (gnat_node)));
+}
+
 /* Similar to set_expr_location, but start with the Sloc of GNAT_NODE and
    don't do anything if it doesn't correspond to a source location.  And,
    if CLEAR_COLUMN is true, set the column information to 0.  */
@@ -10014,6 +10038,16 @@  set_expr_location_from_node (tree node,
 {
   location_t locus;
 
+  /* Do not set a location for constructs likely to disturb debugging.  */
+  if (Nkind (gnat_node) == N_Defining_Identifier)
+    {
+      if (Is_Type (gnat_node) && Is_Actual_Subtype (gnat_node))
+	return;
+
+      if (renaming_from_instantiation_p (gnat_node))
+	return;
+    }
+
   if (!Sloc_to_locus (Sloc (gnat_node), &locus, clear_column))
     return;
 
Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c	(revision 262495)
+++ gcc-interface/utils.c	(working copy)
@@ -2938,37 +2938,6 @@  value_factor_p (tree value, HOST_WIDE_IN
   return false;
 }
 
-/* Return whether GNAT_NODE is a defining identifier for a renaming that comes
-   from the parameter association for the instantiation of a generic.  We do
-   not want to emit source location for them: the code generated for their
-   initialization is likely to disturb debugging.  */
-
-bool
-renaming_from_instantiation_p (Node_Id gnat_node)
-{
-  if (Nkind (gnat_node) != N_Defining_Identifier
-      || !Is_Object (gnat_node)
-      || Comes_From_Source (gnat_node)
-      || !Present (Renamed_Object (gnat_node)))
-    return false;
-
-  /* Get the object declaration of the renamed object, if any and if the
-     renamed object is a mere identifier.  */
-  gnat_node = Renamed_Object (gnat_node);
-  if (Nkind (gnat_node) != N_Identifier)
-    return false;
-
-  gnat_node = Entity (gnat_node);
-  if (!Present (Parent (gnat_node)))
-    return false;
-
-  gnat_node = Parent (gnat_node);
-  return
-   (Present (gnat_node)
-    && Nkind (gnat_node) == N_Object_Declaration
-    && Present (Corresponding_Generic_Association (gnat_node)));
-}
-
 /* Defer the initialization of DECL's DECL_CONTEXT attribute, scheduling to
    feed it with the elaboration of GNAT_SCOPE.  */