Upstream-Status: Inappropriate [Backport] From ead753a2ac74bd306d240de4760b7f809c581052 Mon Sep 17 00:00:00 2001 From: burnus Date: Tue, 26 Apr 2011 08:41:31 +0000 Subject: [PATCH 180/200] 2011-04-26 Tobias Burnus 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 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 index 923f8c6..94b4459 100644 --- 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 --- 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); 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" } } -- 1.7.0.4