From patchwork Sat Jan 18 20:17:08 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 312331 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]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 45BF22C0098 for ; Sun, 19 Jan 2014 07:17:35 +1100 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:cc:subject:references :in-reply-to:content-type; q=dns; s=default; b=iZPXhk4rKaY7SJgej H9OeahrxvDBAHutl8+vYFOif1eetO6/HWwHwxNUSpZlViA/i7BaDzX1bvzKcv4AN S5EQIpL/+cwvUYmmFU5SZvpVA6KTLuCtYTSTcGjMU8jbeQANJZRqr0OqMxVZC46l sksaDrwf5hTyGyen1RfQ2kpo4U= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:cc:subject:references :in-reply-to:content-type; s=default; bh=BxS8vh+mObHUTy3H74DJIAw bzzg=; b=nAaG8BEgQaHnPZ3k/cect6vUWv7MF75SVfrjPkPvVzsZzfg3Xo96SsX LoJ7IjqSVtfHq/MSVVisuzP1BI2TlqnSILdgks3wZb9XZovnPeno6cWJ1Qg/RUTU 5iv7uzoNZSNHqqnQY36aalMGQD4sCjbGdlEBPWADuFSrusJ0xas4= Received: (qmail 1616 invoked by alias); 18 Jan 2014 20:17:27 -0000 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 Received: (qmail 1592 invoked by uid 89); 18 Jan 2014 20:17:27 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.3 required=5.0 tests=BAYES_00, RCVD_IN_DNSWL_NONE, RP_MATCHES_RCVD, SPF_PASS autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 3 recipients X-HELO: smtp24.services.sfr.fr Received: from smtp24.services.sfr.fr (HELO smtp24.services.sfr.fr) (93.17.128.81) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sat, 18 Jan 2014 20:17:25 +0000 Received: from filter.sfr.fr (localhost [127.0.0.1]) by msfrf2409.sfr.fr (SMTP Server) with ESMTP id E44F070000A3; Sat, 18 Jan 2014 21:17:22 +0100 (CET) Received: from tolstoi.local (did75-4-82-66-46-21.fbx.proxad.net [82.66.46.21]) by msfrf2409.sfr.fr (SMTP Server) with ESMTP id 884F8700008C; Sat, 18 Jan 2014 21:17:22 +0100 (CET) X-SFR-UUID: 20140118201722558.884F8700008C@msfrf2409.sfr.fr Message-ID: <52DAE144.8010400@sfr.fr> Date: Sat, 18 Jan 2014 21:17:08 +0100 From: Mikael Morin User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Thunderbird/24.2.0 MIME-Version: 1.0 To: Janus Weil CC: gcc-patches , gfortran Subject: Re: [Patch, fortran] PR58007: unresolved fixup hell References: <52C55062.3000809@sfr.fr> <52D13696.8000909@sfr.fr> In-Reply-To: X-IsSubscribed: yes Hello, Le 11/01/2014 22:48, Janus Weil a écrit : > Good, thanks for checking. As written before, the patch is ok for > trunk from my side. > I finally committed it as revision 206759 (with the second testcase and a bit more comments). > In fact your test case fails with all versions I tried (4.4, 4.6, 4.7, > 4.8 and trunk). So, is it a regression at all? > Well, I guess that due to the touchy nature of the bug, there are cases that work by luck on old versions and fail (by unluck) on newer ones. Thus, I will backport in a few days to 4.8 and 4.7. Mikael Index: gcc/testsuite/gfortran.dg/unresolved_fixup_2.f90 =================================================================== --- gcc/testsuite/gfortran.dg/unresolved_fixup_2.f90 (révision 0) +++ gcc/testsuite/gfortran.dg/unresolved_fixup_2.f90 (révision 206759) @@ -0,0 +1,36 @@ +! { dg-do compile } +! +! PR fortran/58007 +! Unresolved fiixup while loading a module. +! +! This tests that the specification expression A%MAX_DEGREE in module BSR is +! correctly loaded and resolved in program MAIN. +! +! Original testcase from Daniel Shapiro + +module matrix + type :: sparse_matrix + integer :: max_degree + end type +end module + +module bsr + use matrix + + type, extends(sparse_matrix) :: bsr_matrix + end type + + integer :: i1 + integer :: i2 + integer :: i3 +contains + function get_neighbors (A) + type(bsr_matrix), intent(in) :: A + integer :: get_neighbors(A%max_degree) + end function +end module + +program main + use matrix + use bsr +end Index: gcc/testsuite/gfortran.dg/unresolved_fixup_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/unresolved_fixup_1.f90 (révision 0) +++ gcc/testsuite/gfortran.dg/unresolved_fixup_1.f90 (révision 206759) @@ -0,0 +1,44 @@ +! { dg-do compile } +! +! PR fortran/58007 +! Unresolved fixup while loading a module. +! +! This tests that the specification expression A%MAX_DEGREE in module BSR is +! correctly loaded and resolved in program MAIN. +! +! Original testcase from Daniel Shapiro +! Reduced by Tobias Burnus and Janus Weil + +module matrix + type :: sparse_matrix + integer :: max_degree + end type +contains + subroutine init_interface (A) + class(sparse_matrix), intent(in) :: A + end subroutine + real function get_value_interface() + end function +end module + +module ellpack + use matrix +end module + +module bsr + use matrix + type, extends(sparse_matrix) :: bsr_matrix + contains + procedure :: get_neighbors + end type +contains + function get_neighbors (A) + class(bsr_matrix), intent(in) :: A + integer :: get_neighbors(A%max_degree) + end function +end module + +program main + use ellpack + use bsr +end Index: gcc/testsuite/ChangeLog =================================================================== --- gcc/testsuite/ChangeLog (révision 206758) +++ gcc/testsuite/ChangeLog (révision 206759) @@ -1,3 +1,9 @@ +2014-01-18 Mikael Morin + + PR fortran/58007 + * gfortran.dg/unresolved_fixup_1.f90: New test. + * gfortran.dg/unresolved_fixup_2.f90: New test. + 2014-01-18 Jakub Jelinek PR target/58944 @@ -19,7 +25,7 @@ 2014-01-17 Jeff Law - PR middle-end/57904 + PR middle-end/57904 * gfortran.dg/pr57904.f90: New test. 2014-01-17 Paolo Carlini Index: gcc/fortran/ChangeLog =================================================================== --- gcc/fortran/ChangeLog (révision 206758) +++ gcc/fortran/ChangeLog (révision 206759) @@ -1,3 +1,17 @@ +2014-01-18 Mikael Morin + + PR fortran/58007 + * module.c (MOD_VERSION): Bump. + (fp2, find_pointer2): Remove. + (mio_component_ref): Don't forcedfully set the containing derived type + symbol for loading. Remove unused argument. + (mio_ref): Update caller + (mio_symbol): Dump component list earlier. + (skip_list): New argument nest_level. Initialize level with the new + argument. + (read_module): Add forced pointer components association for derived + type symbols. + 2014-01-12 Janus Weil PR fortran/58026 Index: gcc/fortran/module.c =================================================================== --- gcc/fortran/module.c (révision 206758) +++ gcc/fortran/module.c (révision 206759) @@ -82,7 +82,7 @@ /* Don't put any single quote (') in MOD_VERSION, if you want it to be recognized. */ -#define MOD_VERSION "11" +#define MOD_VERSION "12" /* Structure that describes a position within a module file. */ @@ -390,37 +390,6 @@ } -/* Recursive function to find a pointer within a tree by brute force. */ - -static pointer_info * -fp2 (pointer_info *p, const void *target) -{ - pointer_info *q; - - if (p == NULL) - return NULL; - - if (p->u.pointer == target) - return p; - - q = fp2 (p->left, target); - if (q != NULL) - return q; - - return fp2 (p->right, target); -} - - -/* During reading, find a pointer_info node from the pointer value. - This amounts to a brute-force search. */ - -static pointer_info * -find_pointer2 (void *p) -{ - return fp2 (pi_root, p); -} - - /* Resolve any fixups using a known pointer. */ static void @@ -2588,45 +2557,13 @@ the namespace and is not loaded again. */ static void -mio_component_ref (gfc_component **cp, gfc_symbol *sym) +mio_component_ref (gfc_component **cp) { - char name[GFC_MAX_SYMBOL_LEN + 1]; - gfc_component *q; pointer_info *p; p = mio_pointer_ref (cp); if (p->type == P_UNKNOWN) p->type = P_COMPONENT; - - if (iomode == IO_OUTPUT) - mio_pool_string (&(*cp)->name); - else - { - mio_internal_string (name); - - if (sym && sym->attr.is_class) - sym = sym->components->ts.u.derived; - - /* It can happen that a component reference can be read before the - associated derived type symbol has been loaded. Return now and - wait for a later iteration of load_needed. */ - if (sym == NULL) - return; - - if (sym->components != NULL && p->u.pointer == NULL) - { - /* Symbol already loaded, so search by name. */ - q = gfc_find_component (sym, name, true, true); - - if (q) - associate_integer_pointer (p, q); - } - - /* Make sure this symbol will eventually be loaded. */ - p = find_pointer2 (sym); - if (p->u.rsym.state == UNUSED) - p->u.rsym.state = NEEDED; - } } @@ -2983,7 +2920,7 @@ case REF_COMPONENT: mio_symbol_ref (&r->u.c.sym); - mio_component_ref (&r->u.c.component, r->u.c.sym); + mio_component_ref (&r->u.c.component); break; case REF_SUBSTRING: @@ -3855,7 +3792,9 @@ /* Unlike most other routines, the address of the symbol node is already - fixed on input and the name/module has already been filled in. */ + fixed on input and the name/module has already been filled in. + If you update the symbol format here, don't forget to update read_module + as well (look for "seek to the symbol's component list"). */ static void mio_symbol (gfc_symbol *sym) @@ -3865,6 +3804,14 @@ mio_lparen (); mio_symbol_attribute (&sym->attr); + + /* Note that components are always saved, even if they are supposed + to be private. Component access is checked during searching. */ + mio_component_list (&sym->components, sym->attr.vtype); + if (sym->components != NULL) + sym->component_access + = MIO_NAME (gfc_access) (sym->component_access, access_types); + mio_typespec (&sym->ts); if (sym->ts.type == BT_CLASS) sym->attr.class_ok = 1; @@ -3893,15 +3840,6 @@ if (sym->attr.cray_pointee) mio_symbol_ref (&sym->cp_pointer); - /* Note that components are always saved, even if they are supposed - to be private. Component access is checked during searching. */ - - mio_component_list (&sym->components, sym->attr.vtype); - - if (sym->components != NULL) - sym->component_access - = MIO_NAME (gfc_access) (sym->component_access, access_types); - /* Load/save the f2k_derived namespace of a derived-type symbol. */ mio_full_f2k_derived (sym); @@ -3997,14 +3935,17 @@ } -/* Skip a list between balanced left and right parens. */ +/* Skip a list between balanced left and right parens. + By setting NEST_LEVEL one assumes that a number of NEST_LEVEL opening parens + have been already parsed by hand, and the remaining of the content is to be + skipped here. The default value is 0 (balanced parens). */ static void -skip_list (void) +skip_list (int nest_level = 0) { int level; - level = 0; + level = nest_level; do { switch (parse_atom ()) @@ -4638,7 +4579,6 @@ info->u.rsym.ns = atom_int; get_module_locus (&info->u.rsym.where); - skip_list (); /* See if the symbol has already been loaded by a previous module. If so, we reference the existing symbol and prevent it from @@ -4649,11 +4589,46 @@ if (sym == NULL || (sym->attr.flavor == FL_VARIABLE && info->u.rsym.ns !=1)) - continue; + { + skip_list (); + continue; + } info->u.rsym.state = USED; info->u.rsym.sym = sym; + /* The current symbol has already been loaded, so we can avoid loading + it again. However, if it is a derived type, some of its components + can be used in expressions in the module. To avoid the module loading + failing, we need to associate the module's component pointer indexes + with the existing symbol's component pointers. */ + if (sym->attr.flavor == FL_DERIVED) + { + gfc_component *c; + /* First seek to the symbol's component list. */ + mio_lparen (); /* symbol opening. */ + skip_list (); /* skip symbol attribute. */ + + mio_lparen (); /* component list opening. */ + for (c = sym->components; c; c = c->next) + { + pointer_info *p; + int n; + + mio_lparen (); /* component opening. */ + mio_integer (&n); + p = get_integer (n); + if (p->u.pointer == NULL) + associate_integer_pointer (p, c); + skip_list (1); /* component end. */ + } + mio_rparen (); /* component list closing. */ + + skip_list (1); /* symbol end. */ + } + else + skip_list (); + /* Some symbols do not have a namespace (eg. formal arguments), so the automatic "unique symtree" mechanism must be suppressed by marking them as referenced. */