From patchwork Sun Feb 20 14:28:08 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Paul Richard Thomas X-Patchwork-Id: 83742 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 6417BB715F for ; Mon, 21 Feb 2011 01:28:21 +1100 (EST) Received: (qmail 30976 invoked by alias); 20 Feb 2011 14:28:18 -0000 Received: (qmail 30960 invoked by uid 22791); 20 Feb 2011 14:28:16 -0000 X-SWARE-Spam-Status: No, hits=-1.4 required=5.0 tests=AWL, BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, FREEMAIL_FROM, KAM_STOCKGEN, RCVD_IN_DNSWL_LOW X-Spam-Check-By: sourceware.org Received: from mail-bw0-f47.google.com (HELO mail-bw0-f47.google.com) (209.85.214.47) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sun, 20 Feb 2011 14:28:11 +0000 Received: by bwz10 with SMTP id 10so1326422bwz.20 for ; Sun, 20 Feb 2011 06:28:08 -0800 (PST) MIME-Version: 1.0 Received: by 10.204.72.148 with SMTP id m20mr364199bkj.69.1298212088072; Sun, 20 Feb 2011 06:28:08 -0800 (PST) Received: by 10.204.14.143 with HTTP; Sun, 20 Feb 2011 06:28:08 -0800 (PST) Date: Sun, 20 Feb 2011 15:28:08 +0100 Message-ID: Subject: [Patch, fortran] PR44945 - [4.6 Regression] Wrong decl for module vars and PR45077 From: Paul Richard Thomas To: fortran@gcc.gnu.org, gcc-patches Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org The comment before trans-decl.c:gfc_get_module_backend_decl describes the main features of this patch. The key functional change is that a gsymbol is created for modules that are compiled separately and symbols added to its namespace, in order to access the same backend_decl for all use associations. The testcases really only check the fix for pr45077, although the mechanism that fixes pr44945 is tested. This is because PR44945 does not cause a failure for all platforms, or perhaps none at all, as far as Tobias and I can determine. The patch ensures that only one declaration is used in all circumstances. Bootstraps and regtests on FC9/x86_64 - OK for trunk? Paul 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. Index: gcc/fortran/trans-types.c =================================================================== *** gcc/fortran/trans-types.c (revision 170320) --- gcc/fortran/trans-types.c (working copy) *************** gfc_add_field_to_struct (tree context, t *** 2087,2093 **** int gfc_copy_dt_decls_ifequal (gfc_symbol *from, gfc_symbol *to, ! bool from_gsym) { gfc_component *to_cm; gfc_component *from_cm; --- 2087,2093 ---- int gfc_copy_dt_decls_ifequal (gfc_symbol *from, gfc_symbol *to, ! bool from_gsym) { gfc_component *to_cm; gfc_component *from_cm; *************** gfc_get_derived_type (gfc_symbol * deriv *** 2160,2166 **** gfc_component *c; gfc_dt_list *dt; gfc_namespace *ns; - gfc_gsymbol *gsym; gcc_assert (derived && derived->attr.flavor == FL_DERIVED); --- 2160,2165 ---- *************** gfc_get_derived_type (gfc_symbol * deriv *** 2185,2211 **** return derived->backend_decl; } ! /* 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; ! } ! } ! } /* If a whole file compilation, the derived types from an earlier namespace can be used as the the canonical type. */ --- 2184,2196 ---- return derived->backend_decl; } ! /* 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 ! && 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. */ Index: gcc/fortran/trans.h =================================================================== *** gcc/fortran/trans.h (revision 170320) --- gcc/fortran/trans.h (working copy) *************** void gfc_build_builtin_function_decls (v *** 444,449 **** --- 444,452 ---- /* 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 *); Index: gcc/fortran/trans-decl.c =================================================================== *** gcc/fortran/trans-decl.c (revision 170320) --- gcc/fortran/trans-decl.c (working copy) *************** gfc_defer_symbol_init (gfc_symbol * sym) *** 632,637 **** --- 632,695 ---- } + /* 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 *************** gfc_get_symbol_decl (gfc_symbol * sym) *** 1176,1204 **** 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; ! } ! } ! } if (sym->attr.flavor == FL_PROCEDURE) { --- 1234,1244 ---- 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_get_module_backend_decl (sym)) ! return sym->backend_decl; if (sym->attr.flavor == FL_PROCEDURE) { Index: gcc/testsuite/gfortran.dg/whole_file_28.f90 =================================================================== *** gcc/testsuite/gfortran.dg/whole_file_28.f90 (revision 0) --- gcc/testsuite/gfortran.dg/whole_file_28.f90 (revision 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. Index: gcc/testsuite/gfortran.dg/whole_file_29.f90 =================================================================== *** gcc/testsuite/gfortran.dg/whole_file_29.f90 (revision 0) --- gcc/testsuite/gfortran.dg/whole_file_29.f90 (revision 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" } }