From patchwork Sun Dec 18 12:12:21 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Janus Weil X-Patchwork-Id: 706807 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 3thNGh0QJqz9vFX for ; Sun, 18 Dec 2016 23:12:43 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="nOd2Vozd"; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :mime-version:from:date:message-id:subject:to:content-type; q= dns; s=default; b=ctvCdXRulOM17A3Gz17TIrqRWj1E49XVfRvB7KOmccyApJ ZLXIO8PJQx3gnsNBerTs/G6n73wIBuNWJiOoyavSsHrVysdKGura1UEjhXV5c5C0 YwlpRqL6uf65LaPw/FwOTroM9yaK3eHypRFknvlzlIu7GnCohynHcIrpYTDhM= 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 :mime-version:from:date:message-id:subject:to:content-type; s= default; bh=0W/wjJH70FenHYxI4bfTddz3t3U=; b=nOd2Vozd8RwOkDaNBxIU RwqrJjjRA2Ae0SJOHwmsQ4+pv7eeqMhp+S8DWgbAzLJuG8YPMsZjiz3WBxAptJ4o GvXAngdezCaZZlUSUDAHZg3e465T9MnrG4FCBMdZRxPkH8A9JWiiyRMLpG0MbT80 L8Au7IrkFLVDjFWr4M7YyB0= Received: (qmail 96440 invoked by alias); 18 Dec 2016 12:12:36 -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 96379 invoked by uid 89); 18 Dec 2016 12:12:33 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.2 required=5.0 tests=AWL, BAYES_00, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, RCVD_IN_DNSWL_LOW, SPF_PASS autolearn=ham version=3.3.2 spammy=sk:morinm, sk:morin-m, U*morin-mikael, morinmikaelorangefr X-Spam-User: qpsmtpd, 2 recipients X-HELO: mail-yb0-f171.google.com Received: from mail-yb0-f171.google.com (HELO mail-yb0-f171.google.com) (209.85.213.171) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 18 Dec 2016 12:12:23 +0000 Received: by mail-yb0-f171.google.com with SMTP id d128so50719562ybh.2; Sun, 18 Dec 2016 04:12:23 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:mime-version:sender:from:date:message-id:subject :to; bh=klKN7lHHczRRArfPZsmhoPxJ/xR6qvrhdp02ZsyyVxs=; b=cZ/a9x/J2HXV39eWXmOmXYkXJmlXz2kqq7Ra6m7FKHbXppicMyl4jnZrNMMlAyu5eL h+fJxoGfaiXy7L+ThlY1/eELVbJjaWS8GLMhjwf+TQ/GUmm3IpulMYZsUc7m547LR/MA PN1hUZAuBvtiY8qwmcTexXzhMUXSPiFk+ruk4MPib6i0gwayyUJDw4/UTzvpodYHZTEJ /umsHxRmoqzsZ/hALv7p5JQqEMOZ9zP/Ime8JWZEmd6o0x5EdOwBst2hu6gjtgn0Gx0s +jsbJTH+RXuGS5PP3/HGLkgzF+L8mRHyEEbA7FmVtFFuFGBjE6gwHD1h80H8RL5CbuwC QevQ== X-Gm-Message-State: AIkVDXKrAQ/Q0jOO96YmhUX6vaqRD2SNnwTuEVoNbKiKOeDzNlTKezOvVphSweC5aHP7g93MVj2UYy8jYTLO+A== X-Received: by 10.37.211.2 with SMTP id e2mr412602ybf.149.1482063141842; Sun, 18 Dec 2016 04:12:21 -0800 (PST) MIME-Version: 1.0 Received: by 10.129.51.145 with HTTP; Sun, 18 Dec 2016 04:12:21 -0800 (PST) From: Janus Weil Date: Sun, 18 Dec 2016 13:12:21 +0100 Message-ID: Subject: [Patch, Fortran, OOP] PR 78848: [7 Regression] ICE on writing CLASS variable with non-typebound DTIO procedure To: gfortran , gcc-patches Hi all, the attached patch fixes an ICE on a valid DTIO example, which is in fact a regression of one of my recent patches. See bugzilla for details. Regtests cleanly on x86_64-linux-gnu. Ok for trunk? Cheers, Janus 2016-12-18 Janus Weil PR fortran/78848 * trans-io.c (get_dtio_proc): Generate non-typebound DTIO call for class variables, if no typebound DTIO procedure is available. 2016-12-18 Janus Weil PR fortran/78848 * gfortran.dg/dtio_22.f90: New test. Index: gcc/fortran/trans-io.c =================================================================== --- gcc/fortran/trans-io.c (revision 243776) +++ gcc/fortran/trans-io.c (working copy) @@ -2180,9 +2180,31 @@ get_dtio_proc (gfc_typespec * ts, gfc_code * code, formatted = true; } - if (ts->type == BT_DERIVED) + if (ts->type == BT_CLASS) + derived = ts->u.derived->components->ts.u.derived; + else + derived = ts->u.derived; + + gfc_symtree *tb_io_st = gfc_find_typebound_dtio_proc (derived, + last_dt == WRITE, formatted); + if (ts->type == BT_CLASS && tb_io_st) { - derived = ts->u.derived; + // polymorphic DTIO call (based on the dynamic type) + gfc_se se; + gfc_expr *expr = gfc_find_and_cut_at_last_class_ref (code->expr1); + gfc_add_vptr_component (expr); + gfc_add_component_ref (expr, + tb_io_st->n.tb->u.generic->specific_st->name); + *dtio_sub = tb_io_st->n.tb->u.generic->specific->u.specific->n.sym; + gfc_init_se (&se, NULL); + se.want_pointer = 1; + gfc_conv_expr (&se, expr); + gfc_free_expr (expr); + return se.expr; + } + else + { + // non-polymorphic DTIO call (based on the declared type) *dtio_sub = gfc_find_specific_dtio_proc (derived, last_dt == WRITE, formatted); @@ -2189,32 +2211,8 @@ get_dtio_proc (gfc_typespec * ts, gfc_code * code, if (*dtio_sub) return gfc_build_addr_expr (NULL, gfc_get_symbol_decl (*dtio_sub)); } - else if (ts->type == BT_CLASS) - { - gfc_symtree *tb_io_st; - derived = ts->u.derived->components->ts.u.derived; - tb_io_st = gfc_find_typebound_dtio_proc (derived, - last_dt == WRITE, formatted); - if (tb_io_st) - { - gfc_se se; - gfc_expr *expr = gfc_find_and_cut_at_last_class_ref (code->expr1); - gfc_add_vptr_component (expr); - gfc_add_component_ref (expr, - tb_io_st->n.tb->u.generic->specific_st->name); - *dtio_sub = tb_io_st->n.tb->u.generic->specific->u.specific->n.sym; - gfc_init_se (&se, NULL); - se.want_pointer = 1; - gfc_conv_expr (&se, expr); - gfc_free_expr (expr); - return se.expr; - } - } - - return NULL_TREE; - } /* Generate the call for a scalar transfer node. */