From: Tobias Burnus Date: Tue, 19 Apr 2011 16:26:13 +0000 (+0200) Subject: re PR fortran/48588 (ICE (segfault) in gfc_get_nodesc_array_type) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=9714ca724859e90773df206f552937ddc4da004c;p=gcc.git re PR fortran/48588 (ICE (segfault) in gfc_get_nodesc_array_type) 2011-04-19 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. 2011-04-19 Tobias Burnus PR fortran/48588 * gfortran.dg/whole_file_33.f90: New. From-SVN: r172718 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 94ee71c8cda..c60ba46edeb 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-04-19 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. + 2011-04-19 Martin Jambor * trans-decl.c (gfc_generate_function_code): Call cgraph_create_node diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index c09589b88e0..5d2237a1089 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 49bd36795cc..bc66cbb3d4d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-04-19 Tobias Burnus + + PR fortran/48588 + * gfortran.dg/whole_file_33.f90: New. + 2011-04-19 Martin Jambor * 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 00000000000..31faeaa0992 --- /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" } }