[PATCH] Fix up debuginfo for VLAs in nested functions

[Jakub Jelinek <jakub at redhat dot com>]

Hi!

Given e.g.:
module module_test
   real :: a(2,2)
end module module_test

program test_pass
   use module_test, ONLY: a
   interface
      subroutine sub_test(a_sub,c_sub,c_size)
        real,target  :: a_sub(:,:)
        integer      :: c_size
        real         :: c_sub(c_size,c_size/2)
      end subroutine sub_test
   end interface
   a(1,1)=1.
   a(2,1)=2.
   a(1,2)=3.
   a(2,2)=4.
   call sub_test(a,a(:,2),2)
end program test_pass


subroutine sub_test(a_sub,c_sub,c_size)
   real,target  :: a_sub(:,:)
   integer      :: c_size
   real         :: c_sub(c_size,c_size/2)

   real,pointer :: b_sub(:,:)

   b_sub => a_sub
   print*,'a_sub',a_sub(:,:)
   print*,'b_sub',b_sub(:,:)
   print*,'c_sub',c_sub(:,:)
   call contained_sub

contains

   subroutine contained_sub
     print*,'a_sub',a_sub(:,:)
     print*,'b_sub',b_sub(:,:)
     print*,'c_sub',c_sub(:,:)
   end subroutine contained_sub

end subroutine sub_test

compiled with -g -O0, the debugger can't print some VLA vars, both
nonlocal or even local, just referenced from some nested function.
With vanilla gcc, in sub_test it prints:
(gdb) p a_sub
$1 = (( 1, 2) ( 3, 4) )
(gdb) p b_sub
$2 = (( 1, 2) ( 3, 4) )
(gdb) p c_sub
$3 = (PTR TO -> ( real(kind=4) (*,*))) 0x601578
and in contained_sub:
(gdb) p a_sub
Cannot access memory at address 0x8000000042
(gdb) p b_sub
$4 = (( 1, 2) ( 3, 4) )
(gdb) p c_sub
$5 = (PTR TO -> ( real(kind=4) (*,*))) 0x601578

With this patch it prints:
(gdb) p a_sub
$1 = (( 1, 2) ( 3, 4) )
(gdb) p b_sub
$2 = (( 1, 2) ( 3, 4) )
(gdb) p c_sub
$3 = (( 3, 4) )
in sub_test and:
(gdb) p a_sub
Cannot access memory at address 0x8000000042
(gdb) p b_sub
$4 = (( 1, 2) ( 3, 4) )
(gdb) p c_sub
$5 = (( 3, 4) )
in contained_sub (note a_sub symbol hasn't been mentioned in the gimplified
code in contained_sub, only a_sub.0, so we don't generate a debug decl for
it (should be a FE business I'd say and isn't solved by this patch)).

One of the changes needed is to honor DECL_BY_REFERENCE even for VAR_DECLs
(those which tree-nested.c creates as replacement for
PARM_DECLs/RESULT_DECLs).  Unfortunately, ATM DECL_BY_REFERENCE shares the
same bit as TREE_PRIVATE.  I believe the C++ FE (the only setter of
TREE_PRIVATE) only sets this on FUNCTION_DECLs/FIELD_DECLs and
static data members (i.e. TREE_STATIC VAR_DECLs), so this patch extends
DECL_BY_REFERENCE uses from PARM_DECL/RESULT_DECL also to !TREE_STATIC
VAR_DECLs.  Without this parameters passed by invisible reference
referenced from nested routines will show up as pointers in the debug info,
which is undesirable.

The other change is something comments in get_{,non}local_debug_decl
already suggest:
/* ??? We should be remapping types as well, surely.  */

This patch does that remapping, but delays it to the end of the unnesting
pass and remaps just those variables that are actually passed through
the chains.

Bootstrapped/regtested on x86_64-linux, ok for trunk?

2009-04-08  Jakub Jelinek  <jakub@redhat.com>

	* tree.h (DECL_BY_REFERENCE): Note that it is also valid for
	!TREE_STATIC VAR_DECLs.
	* dwarf2out.c (loc_by_reference, gen_decl_die): Handle
	DECL_BY_REFERENCE on !TREE_STATIC VAR_DECLs.
	(gen_variable_die): Likewise.  Don't look at TREE_PRIVATE if
	DECL_BY_REFERENCE is valid.
	* dbxout.c (DECL_ACCESSIBILITY_CHAR): Don't look at TREE_PRIVATE
	for PARM_DECLs, RESULT_DECLs or !TREE_STATIC VAR_DECLs.
	* tree-nested.c (get_nonlocal_debug_decl, get_local_debug_decl):
	Copy DECL_BY_REFERENCE.
	(struct nesting_copy_body_data): New type.
	(nesting_copy_decl): New function.
	(finalize_nesting_tree_1): Remap types of debug_var_chain variables,
	if they have variable length.

--- gcc/dwarf2out.c.jj	2009-04-07 08:32:56.000000000 +0200
+++ gcc/dwarf2out.c	2009-04-08 11:10:16.000000000 +0200
@@ -11709,7 +11709,9 @@ loc_by_reference (dw_loc_descr_ref loc, 
   if (loc == NULL)
     return NULL;
 
-  if ((TREE_CODE (decl) != PARM_DECL && TREE_CODE (decl) != RESULT_DECL)
+  if ((TREE_CODE (decl) != PARM_DECL
+       && TREE_CODE (decl) != RESULT_DECL
+       && (TREE_CODE (decl) != VAR_DECL || TREE_STATIC (decl)))
       || !DECL_BY_REFERENCE (decl))
     return loc;
 
@@ -14047,12 +14049,19 @@ gen_variable_die (tree decl, tree origin
   else
     {
       tree type = TREE_TYPE (decl);
+      bool private_flag_valid = true;
 
       add_name_and_src_coords_attributes (var_die, decl);
       if ((TREE_CODE (decl) == PARM_DECL
-	   || TREE_CODE (decl) == RESULT_DECL)
+	   || TREE_CODE (decl) == RESULT_DECL
+	   || (TREE_CODE (decl) == VAR_DECL && !TREE_STATIC (decl)))
 	  && DECL_BY_REFERENCE (decl))
-	add_type_attribute (var_die, TREE_TYPE (type), 0, 0, context_die);
+	{
+	  add_type_attribute (var_die, TREE_TYPE (type), 0, 0, context_die);
+	  /* DECL_BY_REFERENCE uses the same bit as TREE_PRIVATE,
+	     for PARM_DECL, RESULT_DECL or non-static VAR_DECL.  */
+	  private_flag_valid = false;
+	}
       else
 	add_type_attribute (var_die, type, TREE_READONLY (decl),
 			    TREE_THIS_VOLATILE (decl), context_die);
@@ -14065,7 +14074,7 @@ gen_variable_die (tree decl, tree origin
 
       if (TREE_PROTECTED (decl))
 	add_AT_unsigned (var_die, DW_AT_accessibility, DW_ACCESS_protected);
-      else if (TREE_PRIVATE (decl))
+      else if (private_flag_valid && TREE_PRIVATE (decl))
 	add_AT_unsigned (var_die, DW_AT_accessibility, DW_ACCESS_private);
     }
 
@@ -15298,7 +15307,9 @@ gen_decl_die (tree decl, tree origin, dw
 
       /* Output any DIEs that are needed to specify the type of this data
 	 object.  */
-      if (TREE_CODE (decl_or_origin) == RESULT_DECL
+      if ((TREE_CODE (decl_or_origin) == RESULT_DECL
+	   || (TREE_CODE (decl_or_origin) == VAR_DECL
+	       && !TREE_STATIC (decl_or_origin)))
           && DECL_BY_REFERENCE (decl_or_origin))
 	gen_type_die (TREE_TYPE (TREE_TYPE (decl_or_origin)), context_die);
       else
--- gcc/tree.h.jj	2009-04-06 11:48:32.000000000 +0200
+++ gcc/tree.h	2009-04-07 17:16:28.000000000 +0200
@@ -478,7 +478,7 @@ struct tree_common GTY(())
            CALL_EXPR
 
        DECL_BY_REFERENCE in
-           PARM_DECL, RESULT_DECL
+           PARM_DECL, RESULT_DECL, VAR_DECL (only !TREE_STATIC)
 
        OMP_SECTION_LAST in
            OMP_SECTION
@@ -1291,8 +1291,9 @@ extern void omp_clause_range_check_faile
 #define CALL_EXPR_RETURN_SLOT_OPT(NODE) \
   (CALL_EXPR_CHECK (NODE)->base.private_flag)
 
-/* In a RESULT_DECL or PARM_DECL, means that it is passed by invisible
-   reference (and the TREE_TYPE is a pointer to the true type).  */
+/* In a RESULT_DECL, PARM_DECL or VAR_DECL without TREE_STATIC, means that it is
+   passed by invisible reference (and the TREE_TYPE is a pointer to the true
+   type).  */
 #define DECL_BY_REFERENCE(NODE) (DECL_COMMON_CHECK (NODE)->base.private_flag)
 
 /* In a CALL_EXPR, means that the call is the jump from a thunk to the
--- gcc/tree-nested.c.jj	2009-04-06 11:47:30.000000000 +0200
+++ gcc/tree-nested.c	2009-04-08 09:50:55.000000000 +0200
@@ -827,6 +827,11 @@ get_nonlocal_debug_decl (struct nesting_
   TREE_READONLY (new_decl) = TREE_READONLY (decl);
   TREE_ADDRESSABLE (new_decl) = TREE_ADDRESSABLE (decl);
   DECL_SEEN_IN_BIND_EXPR_P (new_decl) = 1;
+  if ((TREE_CODE (decl) == PARM_DECL
+       || TREE_CODE (decl) == RESULT_DECL
+       || TREE_CODE (decl) == VAR_DECL)
+      && DECL_BY_REFERENCE (decl))
+    DECL_BY_REFERENCE (new_decl) = 1;
 
   SET_DECL_VALUE_EXPR (new_decl, x);
   DECL_HAS_VALUE_EXPR_P (new_decl) = 1;
@@ -1240,6 +1245,11 @@ get_local_debug_decl (struct nesting_inf
   TREE_READONLY (new_decl) = TREE_READONLY (decl);
   TREE_ADDRESSABLE (new_decl) = TREE_ADDRESSABLE (decl);
   DECL_SEEN_IN_BIND_EXPR_P (new_decl) = 1;
+  if ((TREE_CODE (decl) == PARM_DECL
+       || TREE_CODE (decl) == RESULT_DECL
+       || TREE_CODE (decl) == VAR_DECL)
+      && DECL_BY_REFERENCE (decl))
+    DECL_BY_REFERENCE (new_decl) = 1;
 
   SET_DECL_VALUE_EXPR (new_decl, x);
   DECL_HAS_VALUE_EXPR_P (new_decl) = 1;
@@ -1944,6 +1954,34 @@ convert_all_function_calls (struct nesti
   while (root);
 }
 
+struct nesting_copy_body_data
+{
+  copy_body_data cb;
+  struct nesting_info *root;
+};
+
+/* A helper subroutine for debug_var_chain type remapping.  */
+
+static tree
+nesting_copy_decl (tree decl, copy_body_data *id)
+{
+  struct nesting_copy_body_data *nid = (struct nesting_copy_body_data *) id;
+  void **slot = pointer_map_contains (nid->root->var_map, decl);
+
+  if (slot)
+    return (tree) *slot;
+
+  if (TREE_CODE (decl) == TYPE_DECL && DECL_ORIGINAL_TYPE (decl))
+    {
+      tree new_decl = copy_decl_no_change (decl, id);
+      DECL_ORIGINAL_TYPE (new_decl)
+	= remap_type (DECL_ORIGINAL_TYPE (decl), id);
+      return new_decl;
+    }
+
+  return copy_decl_no_change (decl, id);
+}
+
 /* Do "everything else" to clean up or complete state collected by the
    various walking passes -- lay out the types and decls, generate code
    to initialize the frame decl, store critical expressions in the
@@ -2076,10 +2114,66 @@ finalize_nesting_tree_1 (struct nesting_
     declare_vars (root->new_local_var_chain,
 		  gimple_seq_first_stmt (gimple_body (root->context)),
 		  false);
+
   if (root->debug_var_chain)
-    declare_vars (root->debug_var_chain,
-		  gimple_seq_first_stmt (gimple_body (root->context)),
-		  true);
+    {
+      tree debug_var;
+
+      for (debug_var = root->debug_var_chain; debug_var;
+	   debug_var = TREE_CHAIN (debug_var))
+	if (variably_modified_type_p (TREE_TYPE (debug_var), NULL))
+	  break;
+
+      /* If there are any debug decls with variable length types,
+	 remap those types using other debug_var_chain variables.  */
+      if (debug_var)
+	{
+	  struct nesting_copy_body_data id;
+
+	  memset (&id, 0, sizeof (id));
+	  id.cb.copy_decl = nesting_copy_decl;
+	  id.cb.decl_map = pointer_map_create ();
+	  id.root = root;
+
+	  for (; debug_var; debug_var = TREE_CHAIN (debug_var))
+	    if (variably_modified_type_p (TREE_TYPE (debug_var), NULL))
+	      {
+		tree type = TREE_TYPE (debug_var);
+		tree newt, t = type;
+		struct nesting_info *i;
+
+		for (i = root; i; i = i->outer)
+		  if (variably_modified_type_p (type, i->context))
+		    break;
+
+		if (i == NULL)
+		  continue;
+
+		id.cb.src_fn = i->context;
+		id.cb.dst_fn = i->context;
+		id.cb.src_cfun = DECL_STRUCT_FUNCTION (root->context);
+
+		TREE_TYPE (debug_var) = newt = remap_type (type, &id.cb);
+		while (POINTER_TYPE_P (newt) && !TYPE_NAME (newt))
+		  {
+		    newt = TREE_TYPE (newt);
+		    t = TREE_TYPE (t);
+		  }
+		if (TYPE_NAME (newt)
+		    && TREE_CODE (TYPE_NAME (newt)) == TYPE_DECL
+		    && DECL_ORIGINAL_TYPE (TYPE_NAME (newt))
+		    && newt != t
+		    && TYPE_NAME (newt) == TYPE_NAME (t))
+		  TYPE_NAME (newt) = remap_decl (TYPE_NAME (newt), &id.cb);
+	      }
+
+	  pointer_map_destroy (id.cb.decl_map);
+	}
+
+      declare_vars (root->debug_var_chain,
+		    gimple_seq_first_stmt (gimple_body (root->context)),
+		    true);
+    }
 
   /* Dump the translated tree function.  */
   dump_function (TDI_nested, root->context);
--- gcc/dbxout.c.jj	2009-04-06 11:47:29.000000000 +0200
+++ gcc/dbxout.c	2009-04-07 17:16:27.000000000 +0200
@@ -1397,7 +1397,9 @@ dbxout_type_index (tree type)
 /* Used in several places: evaluates to '0' for a private decl,
    '1' for a protected decl, '2' for a public decl.  */
 #define DECL_ACCESSIBILITY_CHAR(DECL) \
-(TREE_PRIVATE (DECL) ? '0' : TREE_PROTECTED (DECL) ? '1' : '2')
+((TREE_CODE (DECL) != PARM_DECL && TREE_CODE (DECL) != RESULT_DECL \
+  && (TREE_CODE (DECL) != VAR_DECL || TREE_STATIC (DECL)) \
+  && TREE_PRIVATE (DECL)) ? '0' : TREE_PROTECTED (DECL) ? '1' : '2')
 
 /* Subroutine of `dbxout_type'.  Output the type fields of TYPE.
    This must be a separate function because anonymous unions require

	Jakub