From patchwork Sun Sep 26 18:42:11 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Daniel Kraft X-Patchwork-Id: 65798 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 2E451B70E1 for ; Mon, 27 Sep 2010 04:36:48 +1000 (EST) Received: (qmail 31121 invoked by alias); 26 Sep 2010 18:36:46 -0000 Received: (qmail 31107 invoked by uid 22791); 26 Sep 2010 18:36:45 -0000 X-SWARE-Spam-Status: No, hits=-2.5 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_LOW, SPF_HELO_PASS X-Spam-Check-By: sourceware.org Received: from tatiana.utanet.at (HELO tatiana.utanet.at) (213.90.36.46) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sun, 26 Sep 2010 18:36:36 +0000 Received: from plenty.xoc.tele2net.at ([213.90.36.8]) by tatiana.utanet.at with esmtp (Exim 4.71) (envelope-from ) id 1Ozw5S-000750-D4; Sun, 26 Sep 2010 20:36:34 +0200 Received: from d86-33-197-25.cust.tele2.at ([86.33.197.25] helo=[192.168.1.18]) by plenty.xoc.tele2net.at with esmtpa (Exim 4.71) (envelope-from ) id 1Ozw5S-00060S-6o; Sun, 26 Sep 2010 20:36:34 +0200 Message-ID: <4C9F9403.2080906@domob.eu> Date: Sun, 26 Sep 2010 20:42:11 +0200 From: Daniel Kraft User-Agent: Thunderbird 2.0.0.0 (X11/20070425) MIME-Version: 1.0 To: Fortran List , gcc-patches Subject: [Patch, Fortran] PR fortran/45783 and PR fortran/45795: Fix ICE in gfc_add_component_ref 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 Hi, this trivial patch fixes the two PRs about ICE in gfc_add_component_ref. I only added the test-case from PR 45795, but I think this is enough and ok. The problem was that my definability patch changed the order of resolution for SELECT TYPE vs. its contained code, and this uncovered a bug introduced when I changed SELECT TYPE to use ASSOCIATE logic internally. Namely, that the associate-name gets its target's typespec -- this is wrong for SELECT TYPE obviously. I will regtest now on x86_64-unknown-linux-gnu. Ok for trunk if no failures? Yours, Daniel Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 164634) +++ gcc/fortran/resolve.c (working copy) @@ -7570,7 +7570,11 @@ resolve_assoc_var (gfc_symbol* sym, bool sym->attr.target = (tsym->attr.target || tsym->attr.pointer); } - sym->ts = target->ts; + /* Get type if this was not already set. Note that it can be + some other type than the target in case this is a SELECT TYPE + selector! So we must not update when the type is already there. */ + if (sym->ts.type == BT_UNKNOWN) + sym->ts = target->ts; gcc_assert (sym->ts.type != BT_UNKNOWN); /* See if this is a valid association-to-variable. */ @@ -7673,8 +7677,8 @@ resolve_select_type (gfc_code *code, gfc error++; continue; } - else - default_case = body; + + default_case = body; } } Index: gcc/testsuite/gfortran.dg/select_type_18.f03 =================================================================== --- gcc/testsuite/gfortran.dg/select_type_18.f03 (revision 0) +++ gcc/testsuite/gfortran.dg/select_type_18.f03 (revision 0) @@ -0,0 +1,90 @@ +! { dg-do compile } + +! PR fortran/45783 +! PR fortran/45795 +! This used to fail because of incorrect compile-time typespec on the +! SELECT TYPE selector. + +! This is the test-case from PR 45795. +! Contributed by Salvatore Filippone, sfilippone@uniroma2.it. + +module base_mod + + type :: base + integer :: m, n + end type base + +end module base_mod + +module s_base_mod + + use base_mod + + type, extends(base) :: s_base + contains + procedure, pass(a) :: cp_to_foo => s_base_cp_to_foo + + end type s_base + + + type, extends(s_base) :: s_foo + + integer :: nnz + integer, allocatable :: ia(:), ja(:) + real, allocatable :: val(:) + + contains + + procedure, pass(a) :: cp_to_foo => s_cp_foo_to_foo + + end type s_foo + + + interface + subroutine s_base_cp_to_foo(a,b,info) + import :: s_base, s_foo + class(s_base), intent(in) :: a + class(s_foo), intent(inout) :: b + integer, intent(out) :: info + end subroutine s_base_cp_to_foo + end interface + + interface + subroutine s_cp_foo_to_foo(a,b,info) + import :: s_foo + class(s_foo), intent(in) :: a + class(s_foo), intent(inout) :: b + integer, intent(out) :: info + end subroutine s_cp_foo_to_foo + end interface + +end module s_base_mod + + +subroutine trans2(a,b) + use s_base_mod + implicit none + + class(s_base), intent(out) :: a + class(base), intent(in) :: b + + type(s_foo) :: tmp + integer err_act, info + + + info = 0 + select type(b) + class is (s_base) + call b%cp_to_foo(tmp,info) + class default + info = -1 + write(*,*) 'Invalid dynamic type' + end select + + if (info /= 0) write(*,*) 'Error code ',info + + return + +end subroutine trans2 + +! { dg-final { cleanup-modules "base_mod s_base_mod" } }