re PR fortran/48588 (ICE (segfault) in gfc_get_nodesc_array_type)

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.

From-SVN: r172718

4 files changed, 109 insertions, 10 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 94ee71c..c60ba46 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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  Martin Jambor  <mjambor@suse.cz>
 
 	* trans-decl.c (gfc_generate_function_code): Call cgraph_create_node
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);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 49bd367..bc66cbb 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-04-19  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/48588
+	* gfortran.dg/whole_file_33.f90: New.
+
 2011-04-19  Martin Jambor  <mjambor@suse.cz>
 
 	* g++.dg/ipa/devirt-7.C: New test.
diff --git a/gcc/testsuite/gfortran.dg/whole_file_33.f90 b/gcc/testsuite/gfortran.dg/whole_file_33.f90
new file mode 100644
index 0000000..31faeaa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_33.f90
@@ -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" } }