This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH] Small Fortran debuginfo fixes for contained functions


Hi!

The following patch fixes debuginfo for say:
  integer, target :: a (3, 2:4)
  integer :: i
  integer, pointer :: b (:, :)
  a = reshape ((/( i, i = 1, 9 )/), (/ 3, 3 /))
  b => a
  call subr
contains
  subroutine subr
    b(2, 3) = 10
    b(3, 4) = 11
  end subroutine subr
end

so that you can actually print b correctly inside of subr.
There are two issues:
1) gfc_build_qualified_array wouldn't create the multidimensional
   debug only type if nest is true, but if the nested fn is translated
   first (which is usually the case), then it won't be generated right
   away and when actually needed even when !nest, gfc_build_qualified_array
   won't be called again, as the backend_decl already exists.
2) unlike C/C++, Fortran FE doesn't have the outermost BLOCK (DECL_INITIAL
   (fndecl)) on the outermost BIND_EXPR/GIMPLE_BIND.  If that GIMPLE_BIND
   has NULL BLOCK, which is often the case, then tree-nested simply won't
   add the needed DECL_VALUE_EXPR VAR_DECLs to the BLOCK, so dwarf2out
   doesn't emit them.

This patch fixes both of these issues.  Ok for trunk if bootstrap/regtest
pass?

There is still a bunch of important issues with nested fn debugging
though (both Fortran and C), namely that tree-nested.c doesn't adjust VLA
types nor the Fortran debug only multidimensional types and if VLA vars
are represented by a different pointer (say a.0 for a), nothing adds a
needed VAR_DECL with DECL_VALUE_EXPR for debuginfo purposes in the nested
function - the nested function just contains DECL_ARTIFICIAL a.0.
But I think this should be fixed incrementally rather than in one large
patch.  Example of testcase that is strictly improved by this patch, but
still needs work, is e.g.
subroutine foo(parma,parmb,parmc)
   real,target  :: parma(:,:)
   integer      :: parmc
   real         :: parmb(parmc,parmc/2)
   integer	:: x
   real,pointer :: varb(:,:)
   x = parmb(1,1)
   varb => parma
   call bar
contains
   subroutine bar
     print*,'parma',parma(:,:)
     print*,'varb',varb(:,:)
     print*,'parmb',parmb(:,:)
   end subroutine bar
end subroutine foo
program baz
   interface
     subroutine foo(parma,parmb,parmc)
       real,target  :: parma(:,:)
       integer      :: parmc
       real         :: parmb(parmc,parmc/2)
     end subroutine foo
   end interface
   real :: vara(2,2)
   vara(1,1)=1.
   vara(2,1)=2.
   vara(1,2)=3.
   vara(2,2)=4.
   call foo(vara,vara(:,2),2)
end program baz

or

int foo (int parm)
{
  int var = 0;
  int arr[parm];
  int bar (void)
  {
    return parm + var + arr[0];
  }
  arr[0] = 0;
  arr[parm - 1] = 0;
  parm++;
  var++;
  return bar ();
}

int
main (void)
{
  return foo (4) - 6;
}

2008-10-07  Jakub Jelinek  <jakub@redhat.com>

	* f95-lang.c (poplevel): Don't clear BLOCK_VARS if functionbody.
	* trans-decl.c (gfc_build_qualified_array): Build accurate debug type
	even if nest.
	(build_entry_thunks, gfc_generate_function_code,
	gfc_generate_constructors): Ensure DECL_SAVED_TREE is a BIND_EXPR
	with DECL_INITIAL as its BLOCK.

--- gcc/fortran/f95-lang.c.jj	2008-10-04 11:24:35.000000000 +0200
+++ gcc/fortran/f95-lang.c	2008-10-07 12:58:49.000000000 +0200
@@ -430,14 +430,8 @@ poplevel (int keep, int reverse, int fun
   current_binding_level = current_binding_level->level_chain;
 
   if (functionbody)
-    {
-      /* This is the top level block of a function. The ..._DECL chain stored
-         in BLOCK_VARS are the function's parameters (PARM_DECL nodes). Don't
-         leave them in the BLOCK because they are found in the FUNCTION_DECL
-         instead.  */
-      DECL_INITIAL (current_function_decl) = block_node;
-      BLOCK_VARS (block_node) = 0;
-    }
+    /* This is the top level block of a function. */
+    DECL_INITIAL (current_function_decl) = block_node;
   else if (current_binding_level == global_binding_level)
     /* When using gfc_start_block/gfc_finish_block from middle-end hooks,
        don't add newly created BLOCKs as subblocks of global_binding_level.  */
--- gcc/fortran/trans-decl.c.jj	2008-10-06 15:02:07.000000000 +0200
+++ gcc/fortran/trans-decl.c	2008-10-07 13:02:36.000000000 +0200
@@ -704,7 +704,7 @@ gfc_build_qualified_array (tree decl, gf
       layout_type (type);
     }
 
-  if (nest || write_symbols == NO_DEBUG)
+  if (write_symbols == NO_DEBUG)
     return;
 
   if (TYPE_NAME (type) != NULL_TREE
@@ -1761,7 +1761,7 @@ build_entry_thunks (gfc_namespace * ns)
 
       thunk_fndecl = thunk_sym->backend_decl;
 
-      gfc_start_block (&body);
+      gfc_init_block (&body);
 
       /* Pass extra parameter identifying this entry point.  */
       tmp = build_int_cst (gfc_array_index_type, el->id);
@@ -1869,8 +1869,12 @@ build_entry_thunks (gfc_namespace * ns)
 
       /* Finish off this function and send it for code generation.  */
       DECL_SAVED_TREE (thunk_fndecl) = gfc_finish_block (&body);
+      tmp = getdecls ();
       poplevel (1, 0, 1);
       BLOCK_SUPERCONTEXT (DECL_INITIAL (thunk_fndecl)) = thunk_fndecl;
+      DECL_SAVED_TREE (thunk_fndecl)
+	= build3_v (BIND_EXPR, tmp, DECL_SAVED_TREE (thunk_fndecl),
+		    DECL_INITIAL (thunk_fndecl));
 
       /* Output the GENERIC tree.  */
       dump_function (TDI_original, thunk_fndecl);
@@ -3652,7 +3656,7 @@ gfc_generate_function_code (gfc_namespac
 
   trans_function_start (sym);
 
-  gfc_start_block (&block);
+  gfc_init_block (&block);
 
   if (ns->entries && ns->proc_name->ts.type == BT_CHARACTER)
     {
@@ -3886,11 +3890,16 @@ gfc_generate_function_code (gfc_namespac
   saved_function_decls = NULL_TREE;
 
   DECL_SAVED_TREE (fndecl) = gfc_finish_block (&block);
+  decl = getdecls ();
 
   /* Finish off this function and send it for code generation.  */
   poplevel (1, 0, 1);
   BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
 
+  DECL_SAVED_TREE (fndecl)
+    = build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (fndecl),
+		DECL_INITIAL (fndecl));
+
   /* Output the GENERIC tree.  */
   dump_function (TDI_original, fndecl);
 
@@ -3969,9 +3978,13 @@ gfc_generate_constructors (void)
       DECL_SAVED_TREE (fndecl) = build_stmt (EXPR_STMT, tmp);
     }
 
+  decl = getdecls ();
   poplevel (1, 0, 1);
 
   BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
+  DECL_SAVED_TREE (fndecl)
+    = build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (fndecl),
+		DECL_INITIAL (fndecl));
 
   free_after_parsing (cfun);
   free_after_compilation (cfun);

	Jakub


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]