2011-04-26 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.
        * module.c (fix_mio_expr): Commit created symbol.

2011-04-26  Tobias Burnus  <burnus@net-b.de>

        PR fortran/48588
        * gfortran.dg/whole_file_33.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_6-branch@172953 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 19a831b..2f52976 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2011-04-26  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.
+       * module.c (fix_mio_expr): Commit created symbol.
+
 2011-04-13  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/48360

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 923f8c6..94b4459 100644 (file)
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -3011,6 +3011,7 @@ fix_mio_expr (gfc_expr *e)
       sym->attr.flavor = FL_PROCEDURE;
       sym->attr.generic = 1;
       e->symtree = gfc_find_symtree (gfc_current_ns->sym_root, fname);
+      gfc_commit_symbol (sym);
     }
 }
 

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 7fc3dca..7b24cc4 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 4a98056..8b4a2f4 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-04-26  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/48588
+       * gfortran.dg/whole_file_33.f90: New.
+
 2011-04-25  Jason Merrill  <jason@redhat.com>
 
        * g++.dg/cpp0x/regress/template-const2.C: New.

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" } }