From patchwork Wed Oct 17 19:59:16 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 985499 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-487755-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=net-b.de Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="OaanFmon"; dkim-atps=neutral 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 42b31663zXz9s55 for ; Thu, 18 Oct 2018 06:59:36 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=aFZBQpPaSr48GD4wX6TSe/Uv76/YGk62cKbNzfUSW/2ieYn/OR zB/ofMMyzK8E21dv+F5QHhxH3SlpVRq+ijB68P0xaD0DW7FZTeZuitC90ldDWWgJ uyaAMkoW5S5wk8HpH5S08SlNoDk8AE07o0Lc/cmXF0cZ+nWaiIgd09w/w= 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:to :from:subject:message-id:date:mime-version:content-type; s= default; bh=w8S8cQQK761JOS5Cp7GM4avKITE=; b=OaanFmon5N8kbWbBi3un Y7pcCr+L30Gr8mx+euT1wR2nDhMipfRPomaf5ZmdjcQfeCEpjsVA6psROw+09y0g +8HSfK5gPZAIo5/XSuaOvYbLo3zHHzxMO9uW5aegeWtaDANlzK1fi5hvkhtLd28S ZFEYuQffIKsW7Q0Qye9ae5w= Received: (qmail 29026 invoked by alias); 17 Oct 2018 19:59:23 -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 29002 invoked by uid 89); 17 Oct 2018 19:59:22 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-25.1 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_LAZY_DOMAIN_SECURITY, RCVD_IN_DNSWL_LOW autolearn=ham version=3.3.2 spammy= X-HELO: mx-relay43-hz2.antispameurope.com Received: from mx-relay43-hz2.antispameurope.com (HELO mx-relay43-hz2.antispameurope.com) (94.100.136.243) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 17 Oct 2018 19:59:21 +0000 Received: from s041.bre.qsc.de ([195.90.7.81]) by mx-relay43-hz2.antispameurope.com; Wed, 17 Oct 2018 21:59:18 +0200 Received: from tux.net-b.de (port-92-194-24-29.dynamic.qsc.de [92.194.24.29]) by s041.bre.qsc.de (Postfix) with ESMTPSA id 532BC2C00C7; Wed, 17 Oct 2018 21:59:17 +0200 (CEST) To: gcc-patches , gfortran From: Tobias Burnus Subject: [Patch, Fortan] PR 87632 - fix select type ICE Message-ID: <7079a01f-97e3-debc-ad93-441a6348b3c3@net-b.de> Date: Wed, 17 Oct 2018 21:59:16 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:60.0) Gecko/20100101 Thunderbird/60.0 MIME-Version: 1.0 X-cloud-security-sender: burnus@net-b.de X-cloud-security-recipient: gcc-patches@gcc.gnu.org X-cloud-security-Virusscan: CLEAN X-cloud-security-disclaimer: This E-Mail was scanned by E-Mailservice on mx-relay43-hz2.antispameurope.com with CDFE7B85C5A X-cloud-security-connect: s041.bre.qsc.de[195.90.7.81], TLS=1, IP=195.90.7.81 X-cloud-security: scantime:.1925 Due to using the wrong variable, gfortran will segfault – as ref is always NULL. Build and regtested on x86-64-gnu-linux. Committed as obvious in Rev. 265248. Tobias PR fortran/87632 * resolve.c (resolve_select_type): Use correct variable. PR fortran/87632 * gfortran.dg/select_type_47.f90: New. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 7c0381698cb..7ec9e969c71 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8914,7 +8914,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) if (ref2) { if (code->expr1->symtree->n.sym->attr.untyped) - code->expr1->symtree->n.sym->ts = ref->u.c.component->ts; + code->expr1->symtree->n.sym->ts = ref2->u.c.component->ts; selector_type = CLASS_DATA (ref2->u.c.component)->ts.u.derived; } else diff --git a/gcc/testsuite/gfortran.dg/select_type_47.f90 b/gcc/testsuite/gfortran.dg/select_type_47.f90 new file mode 100644 index 00000000000..c7a750e35ac --- /dev/null +++ b/gcc/testsuite/gfortran.dg/select_type_47.f90 @@ -0,0 +1,59 @@ +! { dg-do compile } +! +! PR fortran/87632 +! +! Contributed by Jürgen Reuter +! +module m +type t + integer :: i +end type t +type t2 + type(t) :: phs_config +end type t2 +end module m + +module m2 +use m +implicit none +type t3 +end type t3 + +type process_t + private + type(t2), allocatable :: component(:) +contains + procedure :: get_phs_config => process_get_phs_config +end type process_t + +contains + subroutine process_extract_resonance_history_set & + (process, include_trivial, i_component) + class(process_t), intent(in), target :: process + logical, intent(in), optional :: include_trivial + integer, intent(in), optional :: i_component + integer :: i + i = 1; if (present (i_component)) i = i_component + select type (phs_config => process%get_phs_config (i)) + class is (t) + call foo() + class default + call bar() + end select + end subroutine process_extract_resonance_history_set + + function process_get_phs_config (process, i_component) result (phs_config) + class(t), pointer :: phs_config + class(process_t), intent(in), target :: process + integer, intent(in) :: i_component + if (allocated (process%component)) then + phs_config => process%component(i_component)%phs_config + else + phs_config => null () + end if + end function process_get_phs_config +end module m2 + +program main + use m2 +end program main