[Patch, Fortran] PR 48588 - (4.6/4.7 regression) Resolve whole TU before generating code

[Tobias Burnus <burnus@net-b.de>]

[-- Attachment #1: Type: text/plain, Size: 1325 bytes --]

Currently, gfortran ships (trans*.c) MODULEs directly while it waits 
until the end for subroutines, functions and PROGRAM. The latter are 
then first all resolved and afterwards the middle-end code is generated.

In the PR this shows an issue: The a module procedure calls an external 
subroutine - which exists as gsym. In trans-decl one therefore uses the 
symbol information from gsym, which causes an ICE as the latter has not 
yet been resolved.

The solution is to first resolve the whole translation unit (file) 
before starting to generate middle end code. The only disadvantage is 
that it increases the required memory, however, it might be easier to 
re-use the module data later when gfortran stops reading module files 
all the time. I am also not 100% sure that I free all structures, though 
the patch probably frees most.

Build and regtested on x86-64-linux.
OK for the trunk - and after some grace period - for the 4.6 branch?

Tobias

PS: The code works with -fno-whole-file as then the code is always 
generated immediately. (Additionally, gsym is not used then.)

PPS: There are still three open 4.6/4.7 regressions - besides this one 
and the -frealloc-lhs issue Paul is working on. We should really fix 
those before 4.6.1 is released and Linux distributions and others start 
to heavily using 4.6.x.

[-- Attachment #2: whole-file-parse.diff --]
[-- Type: text/x-patch, Size: 5218 bytes --]

2011-04-19  Tobias Burnus  <burnus@net-b.de>
	PR fortran/48588
	* parse.c (resolve_all_program_units): Skip modules.
	(translate_all_program_units): Handle modules.
	(gfc_parse_file): Defer code generation for modules.

2011-04-19  Tobias Burnus  <burnus@net-b.de>
	PR fortran/48588
	* gfortran.dg/whole_file_33.f90: New.

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index c09589b..5d2237a 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -4191,6 +4191,10 @@ resolve_all_program_units (gfc_namespace *gfc_global_ns_list)
   gfc_current_ns = gfc_global_ns_list;
   for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
     {
+      if (gfc_current_ns->proc_name
+	  && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
+	continue; /* Already resolved.  */
+
       if (gfc_current_ns->proc_name)
 	gfc_current_locus = gfc_current_ns->proc_name->declared_at;
       gfc_resolve (gfc_current_ns);
@@ -4231,8 +4235,28 @@ translate_all_program_units (gfc_namespace *gfc_global_ns_list)
   gfc_current_ns = gfc_global_ns_list;
   gfc_get_errors (NULL, &errors);
 
+  /* We first translate all modules to make sure that later parts
+     of the program can use the decl. Then we translate the nonmodules.  */
+
+  for (; !errors && gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
+    {
+      if (!gfc_current_ns->proc_name
+	  || gfc_current_ns->proc_name->attr.flavor != FL_MODULE)
+	continue;
+
+      gfc_current_locus = gfc_current_ns->proc_name->declared_at;
+      gfc_derived_types = gfc_current_ns->derived_types;
+      gfc_generate_module_code (gfc_current_ns);
+      gfc_current_ns->translated = 1;
+    }
+
+  gfc_current_ns = gfc_global_ns_list;
   for (; !errors && gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
     {
+      if (gfc_current_ns->proc_name
+	  && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
+	continue;
+
       gfc_current_locus = gfc_current_ns->proc_name->declared_at;
       gfc_derived_types = gfc_current_ns->derived_types;
       gfc_generate_code (gfc_current_ns);
@@ -4243,7 +4267,16 @@ translate_all_program_units (gfc_namespace *gfc_global_ns_list)
   gfc_current_ns = gfc_global_ns_list;
   for (;gfc_current_ns;)
     {
-      gfc_namespace *ns = gfc_current_ns->sibling;
+      gfc_namespace *ns;
+
+      if (gfc_current_ns->proc_name
+	  && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
+	{
+	  gfc_current_ns = gfc_current_ns->sibling;
+	  continue;
+	}
+
+      ns = gfc_current_ns->sibling;
       gfc_derived_types = gfc_current_ns->derived_types;
       gfc_done_2 ();
       gfc_current_ns = ns;
@@ -4375,16 +4408,18 @@ loop:
   if (s.state == COMP_MODULE)
     {
       gfc_dump_module (s.sym->name, errors_before == errors);
-      if (errors == 0)
-	gfc_generate_module_code (gfc_current_ns);
-      pop_state ();
       if (!gfc_option.flag_whole_file)
-	gfc_done_2 ();
+	{
+	  if (errors == 0)
+	    gfc_generate_module_code (gfc_current_ns);
+	  pop_state ();
+	  gfc_done_2 ();
+	}
       else
 	{
 	  gfc_current_ns->derived_types = gfc_derived_types;
 	  gfc_derived_types = NULL;
-	  gfc_current_ns = NULL;
+	  goto prog_units;
 	}
     }
   else
@@ -4429,10 +4464,12 @@ prog_units:
 	= gfc_option.dump_fortran_original ? gfc_global_ns_list : NULL;
 
   for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
-    {
-      gfc_dump_parse_tree (gfc_current_ns, stdout);
-      fputs ("------------------------------------------\n\n", stdout);
-    }
+    if (!gfc_current_ns->proc_name
+	|| gfc_current_ns->proc_name->attr.flavor != FL_MODULE)
+      {
+	gfc_dump_parse_tree (gfc_current_ns, stdout);
+	fputs ("------------------------------------------\n\n", stdout);
+      }
 
   /* Do the translation.  */
   translate_all_program_units (gfc_global_ns_list);
--- /dev/null	2011-04-17 08:11:58.283889637 +0200
+++ b/gcc/testsuite/gfortran.dg/whole_file_33.f90	2011-04-19 10:33:23.502098186 +0200
@@ -0,0 +1,50 @@
+! { dg-do compile }
+!
+! PR fortran/48588
+!
+! Contributed by Andres Legarra.
+!
+
+MODULE LA_PRECISION
+IMPLICIT NONE
+INTEGER, PARAMETER :: dp = KIND(1.0D0)
+END MODULE LA_PRECISION
+
+module lapack90
+INTERFACE
+  SUBROUTINE DGESV_F90( A, B, IPIV, INFO )
+    USE la_precision, ONLY: wp => dp
+    IMPLICIT NONE
+    INTEGER, INTENT(OUT), OPTIONAL         :: INFO
+    INTEGER, INTENT(OUT), OPTIONAL, TARGET :: IPIV(:)
+    REAL(WP), INTENT(IN OUT)               :: A(:,:), B(:,:)
+  END SUBROUTINE DGESV_F90
+END INTERFACE
+end module
+
+SUBROUTINE DGESV_F90( A, B, IPIV, INFO )
+  USE la_precision, ONLY: wp => dp
+  IMPLICIT NONE
+  INTEGER, INTENT(OUT), OPTIONAL         :: INFO
+  INTEGER, INTENT(OUT), OPTIONAL, TARGET :: IPIV(:)
+  REAL(WP), INTENT(IN OUT)               :: A(:,:), B(:,:)
+END SUBROUTINE DGESV_F90
+
+MODULE DENSEOP
+  USE LAPACK90
+  implicit none
+  integer, parameter :: r8 = SELECTED_REAL_KIND( 15, 307 )
+  real(r8)::denseop_tol=1.d-50
+
+  CONTAINS
+
+  SUBROUTINE GEINV8 (x)
+   real(r8)::x(:,:)
+   real(r8),allocatable::x_o(:,:)
+   allocate(x_o(size(x,1),size(x,1)))
+   CALL dgesv_f90(x,x_o)
+   x=x_o
+  END SUBROUTINE GEINV8
+END MODULE DENSEOP
+
+! { dg-final { cleanup-modules "la_precision lapack90 denseop" } }