From patchwork Sun Jun 13 19:11:50 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Jos=C3=A9_Rui_Faustino_de_Sousa?= X-Patchwork-Id: 1491493 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.a=rsa-sha256 header.s=default header.b=nqL0HWct; dkim-atps=neutral Received: from sourceware.org (ip-8-43-85-97.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4G34381Qxxz9sW6 for ; Mon, 14 Jun 2021 05:12:34 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 65E85386FC32 for ; Sun, 13 Jun 2021 19:12:31 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 65E85386FC32 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1623611551; bh=ItQhx7/oraUFRxeR3Z9Qtfl9k/9j/ECBpAXNrnRCfSY=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=nqL0HWctbJMIpKIvutVrhqQ1mXzFevD9L2l78stGRL8lQrdgKoQvnlNUAG+t/A6Tu 024r9nZsfgN2otDYljwWBX+hzFJZNL/oX7V4guKA9b/y7Z4zcy2o2t3q6SSIjc7JVu HqMjI2yLCDNdl36QqdQwzpHKL1lZ9+g8vc9kOK+A= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42e.google.com (mail-wr1-x42e.google.com [IPv6:2a00:1450:4864:20::42e]) by sourceware.org (Postfix) with ESMTPS id E8E9F3857004; Sun, 13 Jun 2021 19:11:52 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org E8E9F3857004 Received: by mail-wr1-x42e.google.com with SMTP id y7so11969374wrh.7; Sun, 13 Jun 2021 12:11:52 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:to:from:subject:message-id:date:user-agent :mime-version:content-language; bh=ItQhx7/oraUFRxeR3Z9Qtfl9k/9j/ECBpAXNrnRCfSY=; b=fFnex9Ka96vF/rQP82bEN7n2HNxvQcMvs2Ifo89d7YD83CfgZG7DVd9FGhFjSlrDO0 L14kQIDp/d2JO8uEBWvSLogPEB5tQZAAhVZYZcoGfAApg5ZW/uuM3pvDOyVW0DhHZLB5 b2YlM1yPTcJk7XjNb0EMRQkJ+TGJI4wRYFnB2ojqm3VIpnQxZSM8A1xSKgphH5V9wWpM Mc1gfoz6RUosftF27SMfzaF0OljFAvm8E1XYXB+1iS9UGI5PvFEM3+9cjV5My/q1jLC1 rT27ewFDJuazC6CbdoVG+LZpW6i9lh7Phv1eOrCm6OQF7wzSLyaoaNq7EKhsY1NxZY9f BO5Q== X-Gm-Message-State: AOAM530d8kHg+Pr5WkzEdVxUIKIZKUV59vHyNjunY27XXjyf8hKhU6qK /fRn0fUEuACYhsjtOE+x7eRcNlJ7mSI= X-Google-Smtp-Source: ABdhPJxqoOy+yeBYk6Y33OG3851446rhQEffsUSFAV9ozXhMSv5+JkkBTReyxAeFOd1ma5I5+rkXtw== X-Received: by 2002:adf:e950:: with SMTP id m16mr15175483wrn.249.1623611511823; Sun, 13 Jun 2021 12:11:51 -0700 (PDT) Received: from ?IPv6:2001:8a0:7d79:6000:9731:6be6:13d:4409? ([2001:8a0:7d79:6000:9731:6be6:13d:4409]) by smtp.googlemail.com with ESMTPSA id r1sm318538wmh.32.2021.06.13.12.11.50 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Sun, 13 Jun 2021 12:11:51 -0700 (PDT) To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [Patch, fortran] PR fortran/100948 - [12 Regression] ICE in gfc_conv_expr_val, at fortran/trans-expr.c:9069 Message-ID: <0cec485c-2071-1dba-aa9d-c41efe66dc1a@gmail.com> Date: Sun, 13 Jun 2021 19:11:50 +0000 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.8.1 MIME-Version: 1.0 Content-Language: en-US X-Spam-Status: No, score=-11.2 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, KAM_NUMSUBJECT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: =?utf-8?q?Jos=C3=A9_Rui_Faustino_de_Sousa_via_Gcc-patches?= From: =?utf-8?q?Jos=C3=A9_Rui_Faustino_de_Sousa?= Reply-To: =?utf-8?q?Jos=C3=A9_Rui_Faustino_de_Sousa?= Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" Hi all! Proposed partial patch to: Bug 100948 - [12 Regression] ICE in gfc_conv_expr_val, at fortran/trans-expr.c:9069 Patch tested only on x86_64-pc-linux-gnu. Reuse previously calculated full string length to set string section default upper bound. This patch only fixes the ICE the code produced is still wrong. Thank you very much. Best regards, José Rui Fortran: Fix ICE. gcc/fortran/ChangeLog: PR fortran/100948 * trans-expr.c (gfc_get_expr_charlen): reuse previously calculated full string length to set string section default upper bound. gcc/testsuite/ChangeLog: PR fortran/100948 * gfortran.dg/PR100948.f90: New test. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index de406ad..1970cfc 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2152,17 +2152,25 @@ gfc_get_expr_charlen (gfc_expr *e) break; case REF_SUBSTRING: - gfc_init_se (&se, NULL); - gfc_conv_expr_type (&se, r->u.ss.start, gfc_charlen_type_node); - length = se.expr; - gfc_conv_expr_type (&se, r->u.ss.end, gfc_charlen_type_node); - length = fold_build2_loc (input_location, MINUS_EXPR, - gfc_charlen_type_node, - se.expr, length); - length = fold_build2_loc (input_location, PLUS_EXPR, - gfc_charlen_type_node, length, - gfc_index_one_node); - break; + { + tree start; + + gfc_init_se (&se, NULL); + gcc_assert (r->u.ss.start); + gfc_conv_expr_type (&se, r->u.ss.start, gfc_charlen_type_node); + start = se.expr; + if (r->u.ss.end) + gfc_conv_expr_type (&se, r->u.ss.end, gfc_charlen_type_node); + else + se.expr = length; + length = fold_build2_loc (input_location, MINUS_EXPR, + gfc_charlen_type_node, + se.expr, start); + length = fold_build2_loc (input_location, PLUS_EXPR, + gfc_charlen_type_node, length, + gfc_index_one_node); + break; + } default: gcc_unreachable (); diff --git a/gcc/testsuite/gfortran.dg/PR100948.f90 b/gcc/testsuite/gfortran.dg/PR100948.f90 new file mode 100644 index 0000000..c0e333f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR100948.f90 @@ -0,0 +1,218 @@ +! { dg-do run } +! +! Tests fix for PR100948 +! +! Based on contribution by JG. Steinmetz +! + +program dct_p + + implicit none + + integer, parameter :: n = 2 + integer, parameter :: m = 3 + + character(len=*), parameter :: u(*) = ["abc", "uvw"] + + type :: dca_t + character(:), allocatable :: c(:) + end type dca_t + + type :: dcp_t + character(:), pointer :: c(:) + end type dcp_t + + character(len=m), target :: a(n) + + a = u + if (size(a)/=n) stop 1 + if (len(a)/=m) stop 2 + if (any(a/=u)) stop 3 + call dcs0(a) + if (size(a)/=n) stop 4 + if (len(a)/=m) stop 5 + if (any(a/=u)) stop 6 + a = u + call dcs1(a) + if (size(a)/=n) stop 7 + if (len(a)/=m) stop 8 + if (any(a/=u)) stop 9 + a = u + call dcs2(a) + if (size(a)/=n) stop 10 + if (len(a)/=m) stop 11 + if (any(a/=u)) stop 12 + a = u + call dcs3(a) + if (size(a)/=n) stop 13 + if (len(a)/=m) stop 14 + if (any(a/=u)) stop 15 + a = u + call dcs4(a) + if (size(a)/=n) stop 16 + if (len(a)/=m) stop 17 + if (any(a/=u)) stop 18 + a = u + call dcs5(a) + if (size(a)/=n) stop 19 + if (len(a)/=m) stop 20 + if (any(a/=u)) stop 21 + a = u + call dcs6(a) + if (size(a)/=n) stop 22 + if (len(a)/=m) stop 23 + if (any(a/=u)) stop 24 + a = u + call dcs7(a) + if (size(a)/=n) stop 25 + if (len(a)/=m) stop 26 + if (any(a/=u)) stop 27 + stop + +contains + + subroutine dcs0(a) + character(len=*), intent(in) :: a(:) + + if (size(a)/=n) stop 28 + if (len(a)/=m) stop 29 + if (any(a/=u)) stop 30 + associate (q => a(:)(:)) + if (size(q)/=n) stop 31 + if (len(q)/=m) stop 32 + if (any(q/=u)) stop 33 + end associate + return + end subroutine dcs0 + + subroutine dcs1(a) + character(len=*), intent(in) :: a(:) + + character(len=len(a)) :: b(size(a)) + + b = a(:)(:) + if (size(b)/=n) stop 34 + if (len(b)/=m) stop 35 + if (any(b/=u)) stop 36 + associate (q => b(:)(:)) + if (size(q)/=n) stop 37 + if (len(q)/=m) stop 38 + if (any(q/=u)) stop 39 + end associate + return + end subroutine dcs1 + + subroutine dcs2(a) + character(len=*), target, intent(in) :: a(:) + + character(:), pointer :: p(:) + + p => a(:)(:) + if (.not.associated(p)) stop 40 + if (.not.associated(p, a)) stop 41 + if (size(p)/=n) stop 42 + if (len(p)/=m) stop 43 + if (any(p/=u)) stop 44 + associate (q => p(:)(:)) + if (size(q)/=n) stop 45 + if (len(q)/=m) stop 46 + if (any(q/=u)) stop 47 + end associate + return + end subroutine dcs2 + + subroutine dcs3(a) + character(len=*), intent(in) :: a(:) + + character(:), allocatable :: b(:) + + b = a(:)(:) + if (size(b)/=n) stop 48 + if (len(b)/=m) stop 49 + if (any(b/=u)) stop 50 + associate (q => b(:)(:)) + if (size(q)/=n) stop 51 + if (len(q)/=m) stop 52 + if (any(q/=u)) stop 53 + end associate + return + end subroutine dcs3 + + subroutine dcs4(a) + character(len=*), intent(in) :: a(:) + + type(dca_t) :: b + + b = dca_t(a) + if (.not.allocated(b%c)) stop 54 + if (size(b%c)/=n) stop 55 + !if (len(b%c)/=m) stop 56 + !if (any(b%c/=u)) stop 57 + associate (q => b%c(:)(:)) + if (size(q)/=n) stop 58 + !if (len(q)/=m) stop 59 + !if (any(q/=u)) stop 60 + end associate + return + end subroutine dcs4 + + subroutine dcs5(a) + character(len=*), target, intent(in) :: a(:) + + type(dcp_t) :: b + + b = dcp_t(a) + if (.not.associated(b%c)) stop 61 + !if (.not.associated(b%c, a)) stop 62 + if (size(b%c)/=n) stop 63 + !if (len(b%c)/=m) stop 64 + !if (any(b%c/=u)) stop 65 + associate (q => b%c(:)(:)) + if (size(q)/=n) stop 66 + !if (len(q)/=m) stop 67 + !if (any(q/=u)) stop 68 + end associate + return + end subroutine dcs5 + + subroutine dcs6(a) + character(len=*), intent(in) :: a(:) + + type(dca_t), allocatable :: b + + b = dca_t(a) + if (.not.allocated(b%c)) stop 69 + if (size(b%c)/=n) stop 70 + !if (len(b%c)/=m) stop 71 + !if (any(b%c/=u)) stop 72 + associate (q => b%c(:)(:)) + if (size(q)/=n) stop 73 + !if (len(q)/=m) stop 74 + !if (any(q/=u)) stop 75 + end associate + deallocate(b) + return + end subroutine dcs6 + + subroutine dcs7(a) + character(len=*), target, intent(in) :: a(:) + + type(dcp_t), allocatable :: b + + b = dcp_t(a) + if (.not.associated(b%c)) stop 76 + !if (.not.associated(b%c, a)) stop 77 + if (size(b%c)/=n) stop 78 + !if (len(b%c)/=m) stop 79 + !if (any(b%c/=u)) stop 80 + associate (q => b%c(:)(:)) + if (size(q)/=n) stop 81 + !if (len(q)/=m) stop 82 + !if (any(q/=u)) stop 83 + end associate + deallocate(b) + return + end subroutine dcs7 + +end program dct_p +