From patchwork Mon Jul 25 20:39:37 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 56319 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id A5B6D3839C57 for ; Mon, 25 Jul 2022 20:40:09 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org A5B6D3839C57 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1658781609; bh=vAbTsn2bH4Yd1Flj+AL7TLtnIhMuzOpEeBPbkhp2tAY=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=goqibI/IICdc4hJ0Rf0OQ1KOL3+XyhedckRZpFfIO1lVAry7xgperVFK6XEAOfpH/ EkDfMuLcTNXl+M1wwqNXPouFoosxpNQ/O3uLp5G4V4zAnjbzOb+HhnPP8KyioF6JgJ X9xypQZYvoCBmSRS2STcYo7oi/DhsFCr61zCRc98= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mout.gmx.net (mout.gmx.net [212.227.17.20]) by sourceware.org (Postfix) with ESMTPS id 9EC113839412; Mon, 25 Jul 2022 20:39:39 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 9EC113839412 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [93.207.82.48] ([93.207.82.48]) by web-mail.gmx.net (3c-app-gmx-bap14.server.lan [172.19.172.84]) (via HTTP); Mon, 25 Jul 2022 22:39:37 +0200 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: [PATCH] Fortran: error recovery from calculation of storage size of a symbol [PR103504] Date: Mon, 25 Jul 2022 22:39:37 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:grxL6cnLtSbf+wiN5nKE3Z2dLirLuBr4O7CLGRAnVRCDZz/58481+lPyEk9UHPUNMRBzq DoGTEZofMWe7jua5UVfRmVvjebWr8+2DTEIUekuRiVQHn1Qwa9AyvqWs0bdsT1iUm6BWPQ569+RA SEXlCV2XDqj2UqYEqixqRHG7tdPbwywbmx4TwIsQdQf4fa1x7hFF9SorOt72CkSt28kVYFNBZtv3 0OiU+iPRC7tV4UD4ExnLrE2fDTskxxdPesvWQ+hK1u+FjgL+nwNuT2s9YhSIrV5ZlzHgNZwGn7/R 7I= X-UI-Out-Filterresults: notjunk:1;V03:K0:01x8sCCFsOo=:tLsQN0IslhdItqGfbLRCD/ vHOelL+6VIiib4PfLTEj7qQy1CZjrPKKCGQmNMBenxGVPF7VhFqnZWWwg1Dpw4cLuzIJoB34Z BKApEML9E0BFYDsYLTT7qEKkL7SXkxQ/FtUjWa1AEoUGbZ/r5S/jKVbox0OeuQGMe23GQAZEX 08YhOJVTZOcQN2SyyfRMrEZucsGMlGYTfLR80VI4Ay71QSvGVgaiejo0YBL9+Uboef3YSBhd1 ex0eLo422e62z6rGn9Qu/0bwHEbLeeQVdUuXTE7K3wBfpSou8gnrtUZtemhQLVpogQcnZLbAi wz8YcTfZmNzEUJIrnDefjV5G6gGLt6ZRNSKTakfiojwimHggDK+9rfqIte6RbPNev5kDHYR8i 0pGDgM6v7a0Y6tQ+l8nXhfqa1RNqpCtFwGWvesdQ5IvP4wUZB/slCJpVSeV+7yv7a0sOByCp9 Lwln8oUBs284ZpVoF876+tNlcsEeN3W2mJMkra9fKLht2A2psX1lE3HCl9a0aLt28XKMk855H IzTYzKuhfYWDKDPmCci++VeIkVu0BmuTVVbc3dBNlQD1048Dc70Rd0QHda8Ops5ubjBAYzXe0 ihoumHP119HO9G9jpuZWbwO/65cb1Xy59rS4r/EKeh2gpffu6jCEwBWlqKO4ycyQGQq3fzct9 vaeNZL7vwz6mtx5vx2f3wDE4gGq41F6TibwsXFfs5nJjwrYTfbMJVRYiyFA4fNKJTMR9NGmTq /O4KLpAlP3PvZ96zxaOtqze6BNWg4xFUMiUJkDEx1AmHzYYO36dW6uSFSPtdOGHNjcdgEiUje Au37efa X-Spam-Status: No, score=-11.1 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) 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: Harald Anlauf via Gcc-patches From: Harald Anlauf Reply-To: Harald Anlauf Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Dear all, we currently may ICE when array bounds of a dummy argument have a non-integer type, and the procedure with the bad declaration is referenced. The same applies to bad character length of dummies. We could simply punt in such a situation, as the causing error seems to be reliably diagnosed, see testcase. Regtested on x86_64-pc-linux-gnu. OK for mainline? This is a really safe fix and potentially backportable to other open branches. Would that be fine? Thanks, Harald From 04bea97afd7f17083774b4309ee4d3c45e278dd3 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 25 Jul 2022 22:29:50 +0200 Subject: [PATCH] Fortran: error recovery from calculation of storage size of a symbol [PR103504] gcc/fortran/ChangeLog: PR fortran/103504 * interface.cc (get_sym_storage_size): Array bounds and character length can only be of integer type. gcc/testsuite/ChangeLog: PR fortran/103504 * gfortran.dg/pr103504.f90: New test. --- gcc/fortran/interface.cc | 7 +++++-- gcc/testsuite/gfortran.dg/pr103504.f90 | 28 ++++++++++++++++++++++++++ 2 files changed, 33 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr103504.f90 diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc index 7ed6e13711f..71eec78259b 100644 --- a/gcc/fortran/interface.cc +++ b/gcc/fortran/interface.cc @@ -2792,7 +2792,8 @@ get_sym_storage_size (gfc_symbol *sym) if (sym->ts.type == BT_CHARACTER) { if (sym->ts.u.cl && sym->ts.u.cl->length - && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT) + && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT + && sym->ts.u.cl->length->ts.type == BT_INTEGER) strlen = mpz_get_ui (sym->ts.u.cl->length->value.integer); else return 0; @@ -2809,7 +2810,9 @@ get_sym_storage_size (gfc_symbol *sym) for (i = 0; i < sym->as->rank; i++) { if (sym->as->upper[i]->expr_type != EXPR_CONSTANT - || sym->as->lower[i]->expr_type != EXPR_CONSTANT) + || sym->as->lower[i]->expr_type != EXPR_CONSTANT + || sym->as->upper[i]->ts.type != BT_INTEGER + || sym->as->lower[i]->ts.type != BT_INTEGER) return 0; elements *= mpz_get_si (sym->as->upper[i]->value.integer) diff --git a/gcc/testsuite/gfortran.dg/pr103504.f90 b/gcc/testsuite/gfortran.dg/pr103504.f90 new file mode 100644 index 00000000000..607d1c6c8cc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr103504.f90 @@ -0,0 +1,28 @@ +! { dg-do compile } +! PR fortran/103504 - ICE in get_sym_storage_size, at fortran/interface.c:2800 +! Contributed by G.Steinmetz + +program p + implicit none + real :: y(1) + character :: b + call s(y) + call t(y) + call u(y) + call c(b) +contains + subroutine s(x) + real :: x(abs(1.):1) ! { dg-error "must be of INTEGER type" } + end + subroutine t(x) + real :: x(abs(1.):1) ! { dg-error "must be of INTEGER type" } + end + subroutine u(x) + real :: x(1:abs(1.)) ! { dg-error "must be of INTEGER type" } + end + subroutine c(z) + character(len=abs(1.)) :: z ! { dg-error "must be of INTEGER type" } + end subroutine c +end + +! { dg-prune-output "must be of INTEGER type" } -- 2.35.3