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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 94ee71c8cda97e433bd2c58fabe89e1df31def02..c60ba46edebf97615e1411bfcbe71f58f68092a4 100644 (file)
--- 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 c09589b88e01fa1f2d29d9c938bb239fb29afe4e..5d2237a108956cb4539346d0829ba7c50e49b0b9 100644 (file)
--- 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 49bd36795ccaa501a6bf763cbf88734ce5c2e0a4..bc66cbb3d4d623f319719623a0eb755089eb3285 100644 (file)
--- 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 (file)
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" } }