From 001c9b94e0754b259bc101983704446e7d4d90ee Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 20 Feb 2011 16:23:50 +0000 Subject: 2011-02-20 Paul Thomas PR fortran/45077 PR fortran/44945 * trans-types.c (gfc_get_derived_type): Remove code that looks for decls in gsym and add call to gfc_get_module_backend_decl. * trans.h : Add prototype for gfc_get_module_backend_decl. * trans-decl.c (gfc_get_module_backend_decl): New function. (gfc_get_symbol_decl): Call it. 2011-02-20 Paul Thomas PR fortran/45077 PR fortran/44945 * gfortran.dg/whole_file_28.f90 : New test. * gfortran.dg/whole_file_29.f90 : New test. git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@170337 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 10 ++++ gcc/fortran/trans-decl.c | 86 +++++++++++++++++++++-------- gcc/fortran/trans-types.c | 25 ++------- gcc/fortran/trans.h | 3 + gcc/testsuite/ChangeLog | 7 +++ gcc/testsuite/gfortran.dg/whole_file_28.f90 | 12 ++++ gcc/testsuite/gfortran.dg/whole_file_29.f90 | 27 +++++++++ 7 files changed, 127 insertions(+), 43 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/whole_file_28.f90 create mode 100644 gcc/testsuite/gfortran.dg/whole_file_29.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f8aa502dd4a..3d98c0a348b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2011-02-20 Paul Thomas + + PR fortran/45077 + PR fortran/44945 + * trans-types.c (gfc_get_derived_type): Remove code that looks + for decls in gsym and add call to gfc_get_module_backend_decl. + * trans.h : Add prototype for gfc_get_module_backend_decl. + * trans-decl.c (gfc_get_module_backend_decl): New function. + (gfc_get_symbol_decl): Call it. + 2011-02-19 Paul Thomas PR fortran/47348 diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 793b2620730..2315b231c81 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -632,6 +632,64 @@ gfc_defer_symbol_init (gfc_symbol * sym) } +/* Used in gfc_get_symbol_decl and gfc_get_derived_type to obtain the + backend_decl for a module symbol, if it all ready exists. If the + module gsymbol does not exist, it is created. If the symbol does + not exist, it is added to the gsymbol namespace. Returns true if + an existing backend_decl is found. */ + +bool +gfc_get_module_backend_decl (gfc_symbol *sym) +{ + gfc_gsymbol *gsym; + gfc_symbol *s; + gfc_symtree *st; + + gsym = gfc_find_gsymbol (gfc_gsym_root, sym->module); + + if (!gsym || (gsym->ns && gsym->type == GSYM_MODULE)) + { + st = NULL; + s = NULL; + + if (gsym) + gfc_find_symbol (sym->name, gsym->ns, 0, &s); + + if (!s) + { + if (!gsym) + { + gsym = gfc_get_gsymbol (sym->module); + gsym->type = GSYM_MODULE; + gsym->ns = gfc_get_namespace (NULL, 0); + } + + st = gfc_new_symtree (&gsym->ns->sym_root, sym->name); + st->n.sym = sym; + sym->refs++; + } + else if (sym->attr.flavor == FL_DERIVED) + { + if (!s->backend_decl) + s->backend_decl = gfc_get_derived_type (s); + gfc_copy_dt_decls_ifequal (s, sym, true); + return true; + } + else if (s->backend_decl) + { + if (sym->ts.type == BT_DERIVED) + gfc_copy_dt_decls_ifequal (s->ts.u.derived, sym->ts.u.derived, + true); + else if (sym->ts.type == BT_CHARACTER) + sym->ts.u.cl->backend_decl = s->ts.u.cl->backend_decl; + sym->backend_decl = s->backend_decl; + return true; + } + } + return false; +} + + /* Create an array index type variable with function scope. */ static tree @@ -1176,29 +1234,11 @@ gfc_get_symbol_decl (gfc_symbol * sym) if (gfc_option.flag_whole_file && (sym->attr.flavor == FL_VARIABLE || sym->attr.flavor == FL_PARAMETER) - && sym->attr.use_assoc && !intrinsic_array_parameter - && sym->module) - { - gfc_gsymbol *gsym; - - gsym = gfc_find_gsymbol (gfc_gsym_root, sym->module); - if (gsym && gsym->ns && gsym->type == GSYM_MODULE) - { - gfc_symbol *s; - s = NULL; - gfc_find_symbol (sym->name, gsym->ns, 0, &s); - if (s && s->backend_decl) - { - if (sym->ts.type == BT_DERIVED) - gfc_copy_dt_decls_ifequal (s->ts.u.derived, sym->ts.u.derived, - true); - if (sym->ts.type == BT_CHARACTER) - sym->ts.u.cl->backend_decl = s->ts.u.cl->backend_decl; - sym->backend_decl = s->backend_decl; - return sym->backend_decl; - } - } - } + && sym->attr.use_assoc + && !intrinsic_array_parameter + && sym->module + && gfc_get_module_backend_decl (sym)) + return sym->backend_decl; if (sym->attr.flavor == FL_PROCEDURE) { diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 0626a87ac46..258685e1017 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -2087,7 +2087,7 @@ gfc_add_field_to_struct (tree context, tree name, tree type, tree **chain) int gfc_copy_dt_decls_ifequal (gfc_symbol *from, gfc_symbol *to, - bool from_gsym) + bool from_gsym) { gfc_component *to_cm; gfc_component *from_cm; @@ -2160,7 +2160,6 @@ gfc_get_derived_type (gfc_symbol * derived) gfc_component *c; gfc_dt_list *dt; gfc_namespace *ns; - gfc_gsymbol *gsym; gcc_assert (derived && derived->attr.flavor == FL_DERIVED); @@ -2185,27 +2184,13 @@ gfc_get_derived_type (gfc_symbol * derived) return derived->backend_decl; } -/* If use associated, use the module type for this one. */ + /* If use associated, use the module type for this one. */ if (gfc_option.flag_whole_file && derived->backend_decl == NULL && derived->attr.use_assoc - && derived->module) - { - gsym = gfc_find_gsymbol (gfc_gsym_root, derived->module); - if (gsym && gsym->ns && gsym->type == GSYM_MODULE) - { - gfc_symbol *s; - s = NULL; - gfc_find_symbol (derived->name, gsym->ns, 0, &s); - if (s) - { - if (!s->backend_decl) - s->backend_decl = gfc_get_derived_type (s); - gfc_copy_dt_decls_ifequal (s, derived, true); - goto copy_derived_types; - } - } - } + && derived->module + && gfc_get_module_backend_decl (derived)) + goto copy_derived_types; /* If a whole file compilation, the derived types from an earlier namespace can be used as the the canonical type. */ diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 9695c5a4db1..40097a9f820 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -444,6 +444,9 @@ void gfc_build_builtin_function_decls (void); /* Set the backend source location of a decl. */ void gfc_set_decl_location (tree, locus *); +/* Get a module symbol backend_decl if possible. */ +bool gfc_get_module_backend_decl (gfc_symbol *); + /* Return the variable decl for a symbol. */ tree gfc_get_symbol_decl (gfc_symbol *); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 00fa79f5c06..077200e47bb 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2011-02-20 Paul Thomas + + PR fortran/45077 + PR fortran/44945 + * gfortran.dg/whole_file_28.f90 : New test. + * gfortran.dg/whole_file_29.f90 : New test. + 2011-02-20 Paolo Carlini PR c++/44118 diff --git a/gcc/testsuite/gfortran.dg/whole_file_28.f90 b/gcc/testsuite/gfortran.dg/whole_file_28.f90 new file mode 100644 index 00000000000..78c848e40e6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/whole_file_28.f90 @@ -0,0 +1,12 @@ +! { dg-do compile } +! Test the fix for the problem described in PR45077 comments #4 and #5. +! Note that the module file is kept for whole_file_29.f90 +! +! Contributed by Tobias Burnus +! +module iso_red + type, public :: varying_string + character(LEN=1), dimension(:), allocatable :: chars + end type varying_string +end module iso_red +! DO NOT CLEAN UP THE MODULE FILE - whole_file_29.f90 does it. diff --git a/gcc/testsuite/gfortran.dg/whole_file_29.f90 b/gcc/testsuite/gfortran.dg/whole_file_29.f90 new file mode 100644 index 00000000000..2521dadac2a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/whole_file_29.f90 @@ -0,0 +1,27 @@ +! { dg-do compile } +! Test the fix for the problem described in PR45077 comments #4 and #5. +! Note that the module file from whole_file_28.f90, 'iso_red', is +! needed for this test. +! +! Contributed by Tobias Burnus +! +module ifiles + use iso_red, string_t => varying_string +contains + function line_get_string_advance (line) result (string) + type(string_t) :: string + character :: line + end function line_get_string_advance +end module ifiles + +module syntax_rules + use iso_red, string_t => varying_string + use ifiles, only: line_get_string_advance +contains + subroutine syntax_init_from_ifile () + type(string_t) :: string + string = line_get_string_advance ("") + end subroutine syntax_init_from_ifile +end module syntax_rules +end +! { dg-final { cleanup-modules "syntax_rules ifiles iso_red" } } -- cgit v1.2.3