From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from cc-smtpout1.netcologne.de (cc-smtpout1.netcologne.de [89.1.8.211]) by sourceware.org (Postfix) with ESMTPS id 1165B3851C29; Sun, 14 Mar 2021 20:18:58 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 1165B3851C29 Received: from cc-smtpin3.netcologne.de (cc-smtpin3.netcologne.de [89.1.8.203]) by cc-smtpout1.netcologne.de (Postfix) with ESMTP id 3921313609; Sun, 14 Mar 2021 21:18:56 +0100 (CET) Received: from linux-p51k.fritz.box (2001-4dd7-6ea1-0-418-1b03-5aef-5a9a.ipv6dyn.netcologne.de [IPv6:2001:4dd7:6ea1:0:418:1b03:5aef:5a9a]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (2048 bits) server-digest SHA256) (No client certificate requested) by cc-smtpin3.netcologne.de (Postfix) with ESMTPSA id 13F1E11DDE; Sun, 14 Mar 2021 21:18:51 +0100 (CET) To: "fortran@gcc.gnu.org" , gcc-patches From: Thomas Koenig Subject: [patch, fortran] Fix PR 99345, ICE with DO loop checking Message-ID: <70f57767-1529-fb28-ec49-0d75fbc31197@netcologne.de> Date: Sun, 14 Mar 2021 21:18:51 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.7.0 MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="------------128AB9A163FF362DF9F71B4D" Content-Language: de-DE X-Spam-Status: No, score=-11.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL, 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: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Sun, 14 Mar 2021 20:18:59 -0000 This is a multi-part message in MIME format. --------------128AB9A163FF362DF9F71B4D Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit Hello world, the attached, rather obvious patch fixes an ICE on valid which came about because I did not handle EXEC_IOLENGTH as start of an I/O statement when checking for the DO loop variable. This is an 11 regression. Thanks to Harald for reducing this down to the bare minimum. Regression-tested on x86_64-pc-linux-gnu. OK for trunk? Best regards Thomas Handle EXEC_IOLENGTH in doloop_contained_procedure_code. gcc/fortran/ChangeLog: PR fortran/99345 * frontend-passes.c (doloop_contained_procedure_code): Properly handle EXEC_IOLENGTH. gcc/testsuite/ChangeLog: PR fortran/99345 * gfortran.dg/do_check_16.f90: New test. * gfortran.dg/do_check_17.f90: New test. --------------128AB9A163FF362DF9F71B4D Content-Type: text/x-patch; charset=UTF-8; name="p1.diff" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="p1.diff" diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 2b9c2d179bb..cfc47471cf1 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -2405,6 +2405,7 @@ doloop_contained_procedure_code (gfc_code **c, case EXEC_READ: case EXEC_WRITE: case EXEC_INQUIRE: + case EXEC_IOLENGTH: saved_io_op = last_io_op; last_io_op = co->op; break; @@ -2460,6 +2461,12 @@ doloop_contained_procedure_code (gfc_code **c, info->procedure->name, &info->where_do); break; + case EXEC_IOLENGTH: + if (co->expr1 && co->expr1->symtree->n.sym == do_var) + gfc_error_now (errmsg, do_var->name, &co->expr1->where, + info->procedure->name, &info->where_do); + break; + default: gcc_unreachable (); } diff --git a/gcc/testsuite/gfortran.dg/do_check_16.f90 b/gcc/testsuite/gfortran.dg/do_check_16.f90 new file mode 100644 index 00000000000..db0d45cb581 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_check_16.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +program main + implicit none + integer :: iq,nq,recl + DO iq = 1, nq + call foobar ! { dg-error "redefined" } + ENDDO +CONTAINS + + subroutine foobar + inquire (iolength=nq) iq ! { dg-error "redefined" } + end subroutine foobar +END program main diff --git a/gcc/testsuite/gfortran.dg/do_check_17.f90 b/gcc/testsuite/gfortran.dg/do_check_17.f90 new file mode 100644 index 00000000000..02b8993de38 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_check_17.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } +! PR 99345 - this used to cause an ICE. +! Original test case by Matthias Klose +program main + implicit none + integer :: iq,nq,recl + DO iq = 1, nq + CALL calc_upper_fan (iq) + ENDDO +CONTAINS + SUBROUTINE calc_upper_fan (iq) + INTEGER :: iq + INTEGER :: recl + INQUIRE(IOLENGTH=recl) iq + END SUBROUTINE calc_upper_fan +END --------------128AB9A163FF362DF9F71B4D--