[PATCH] Fix debuginfo for variable length non-desc fortran arrays

[Jakub Jelinek]

Hi!

The following patch fixes debug info (at least at -O0) for variable
length non-descriptor Fortran arrays.  So far we've been building the
non-flat array type for debuginfo purposes only in
gfc_get_nodesc_array_type, where it only handled constant lower and upper
bounds, optionally with the exception of undefined upper bound in the last
dimension.  For e.g. function types we can't do more, as we need location
of variables to handle the rest, but for PARM_DECLs/VAR_DECLs we can
in gfc_build_qualified_array build the rest.  At -O0 I'm removing
DECL_IGNORED_P from the vars, so that the temporaries aren't optimized out,
for -O1 and above we'll need to wait for VTA.

On the dwarf2out.c side, I wonder why we ever need to create an artificial
variable in add_bound_info (not needed for this patch though):
        if (current_function_decl == 0)
          ctx = comp_unit_die;
        else
          ctx = lookup_decl_die (current_function_decl);

        decl_die = new_die (DW_TAG_variable, ctx, bound);
        add_AT_flag (decl_die, DW_AT_artificial, 1);
        add_type_attribute (decl_die, TREE_TYPE (bound), 1, 0, ctx);
        add_AT_loc (decl_die, DW_AT_location, loc);

        add_AT_die_ref (subrange_die, bound_attr, decl_die);
DWARF3 says that DW_AT_{lower,upper}_bound can be not only a constant
or ref, but can be a block too and we can put loc directly into it
(and e.g. ifort outputs bounds that way).

Attached below is a testcase I've been eyeballing -g -dA -S output for
(apparently gdb has some issues with it too, but for a smaller testcase Jan
said he has a fix).

OT, I think we should stop describing say integer*4 dummy arguments
as DW_TAG_reference_type with DW_AT_type pointing to DW_TAG_base_type
(and various arrays as DW_TAG_pointer_type with DW_AT_type pointing
to DW_TAG_array_type), as the fact that they are passed as references
or being pointed by some pointer is an implementation detail, the
source code contains integer*4 dummy argument or some array.
Instead, DW_AT_location for the thing should dereference it to match the
removal of the pointer/reference type in the debug info.
Not sure how to cleanly tell dwarf2out.c what should be removed this way
though.

2008-08-21  Jakub Jelinek  <jakub@redhat.com>

	* trans-decl.c (gfc_build_qualified_array): Build non-flat
	array type for debug info purposes.
	* dwarf2out.c (add_bound_info): If lookup_decl_die failed, try
	loc_descriptor_from_tree_1.

--- gcc/fortran/trans-decl.c.jj	2008-08-21 11:56:09.000000000 +0200
+++ gcc/fortran/trans-decl.c	2008-08-21 23:07:01.000000000 +0200
@@ -703,6 +703,50 @@ gfc_build_qualified_array (tree decl, gf
       TYPE_DOMAIN (type) = range;
       layout_type (type);
     }
+
+  if (nest || write_symbols == NO_DEBUG)
+    return;
+
+  if (TYPE_NAME (type) != NULL_TREE
+      && GFC_TYPE_ARRAY_UBOUND (type, sym->as->rank - 1) != NULL_TREE
+      && TREE_CODE (GFC_TYPE_ARRAY_UBOUND (type, sym->as->rank - 1)) == VAR_DECL)
+    {
+      tree gtype = DECL_ORIGINAL_TYPE (TYPE_NAME (type));
+
+      for (dim = 0; dim < sym->as->rank - 1; dim++)
+	{
+	  gcc_assert (TREE_CODE (gtype) == ARRAY_TYPE);
+	  gtype = TREE_TYPE (gtype);
+	}
+      gcc_assert (TREE_CODE (gtype) == ARRAY_TYPE);
+      if (TYPE_MAX_VALUE (TYPE_DOMAIN (gtype)) == NULL)
+	TYPE_NAME (type) = NULL_TREE;
+    }
+
+  if (TYPE_NAME (type) == NULL_TREE)
+    {
+      tree gtype = TREE_TYPE (type), rtype, type_decl;
+
+      for (dim = sym->as->rank - 1; dim >= 0; dim--)
+	{
+	  rtype = build_range_type (gfc_array_index_type,
+				    GFC_TYPE_ARRAY_LBOUND (type, dim),
+				    GFC_TYPE_ARRAY_UBOUND (type, dim));
+	  gtype = build_array_type (gtype, rtype);
+	  /* Ensure the bound variables aren't optimized out at -O0.  */
+	  if (!optimize)
+	    {
+	      if (GFC_TYPE_ARRAY_LBOUND (type, dim)
+		  && TREE_CODE (GFC_TYPE_ARRAY_LBOUND (type, dim)) == VAR_DECL)
+		DECL_IGNORED_P (GFC_TYPE_ARRAY_LBOUND (type, dim)) = 0;
+	      if (GFC_TYPE_ARRAY_UBOUND (type, dim)
+		  && TREE_CODE (GFC_TYPE_ARRAY_UBOUND (type, dim)) == VAR_DECL)
+		DECL_IGNORED_P (GFC_TYPE_ARRAY_UBOUND (type, dim)) = 0;
+	    }
+	}
+      TYPE_NAME (type) = type_decl = build_decl (TYPE_DECL, NULL, gtype);
+      DECL_ORIGINAL_TYPE (type_decl) = gtype;
+    }
 }
 
 
--- gcc/dwarf2out.c.jj	2008-08-21 13:15:41.000000000 +0200
+++ gcc/dwarf2out.c	2008-08-21 18:27:30.000000000 +0200
@@ -11943,6 +11943,7 @@ add_bound_info (dw_die_ref subrange_die,
     case RESULT_DECL:
       {
 	dw_die_ref decl_die = lookup_decl_die (bound);
+	dw_loc_descr_ref loc;
 
 	/* ??? Can this happen, or should the variable have been bound
 	   first?  Probably it can, since I imagine that we try to create
@@ -11951,6 +11952,11 @@ add_bound_info (dw_die_ref subrange_die,
 	   later parameter.  */
 	if (decl_die != NULL)
 	  add_AT_die_ref (subrange_die, bound_attr, decl_die);
+	else
+	  {
+	    loc = loc_descriptor_from_tree_1 (bound, 0);
+	    add_AT_location_description (subrange_die, bound_attr, loc);
+	  }
 	break;
       }
 
 

	Jakub
-------------- next part --------------
subroutine foo1 (n, a)
  integer :: n, d, e
  integer :: a(2:n,n/2), b(2:n,n/2)
  d = 1
  b = a
  a(:,:) = 1
  b(:,:) = 2
  e = 2
end subroutine foo1

subroutine foo2 (n, a)
  integer :: n, d, e
  integer :: a(2:n,n/2), b(2:n,n/2)
  d = 1
  a(2,1)=0
  b(2,1)=0
  e = 2
end subroutine foo2

subroutine foo3 (n, a)
  integer :: n, d, e
  integer :: a(2:n), b(2:n)
  d = 1
  a(2)=0
  b(2)=0
  e = 2
end subroutine foo3

subroutine foo4 (n, a)
  integer :: n, d, e
  integer :: a(2:6, n/2), b(2:6,n/2)
  d = 1
  a(2,1)=0
  b(2,1)=0
  e = 2
end subroutine foo4

  integer :: c(2:6,3), d(2:6)
  c(:,1) = 7
  c(:,2) = 8
  c(:,3) = 9
  d(2:3) = 10
  d(4:) = 11
  call foo1 (6, c)
  call foo2 (6, c)
  call foo3 (6, d)
  call foo4 (6, c)
end