From patchwork Sat May 23 17:08:18 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 1296749 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=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=gcc.gnu.org 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=D2OXzhF/; dkim-atps=neutral Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (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 49TqZB0vtHz9sRY for ; Sun, 24 May 2020 03:08:31 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 1F4EE383F843; Sat, 23 May 2020 17:08:25 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 1F4EE383F843 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1590253705; bh=0XxGou3Oup1rvv9ipCdpt/j7CwWv3CS0kVG27/dl90A=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=D2OXzhF/r0cjEMjrYRhMAdDM/V3fuHBK0Or4LwAjYoQQLy3ln6Zt2afLgtOIrj8vP XKdv7rmLcY8TIS1M+Ie81pdoM52FzXwOZOVkwDR9stQ3Ftf0Si4KzfkNvdceXJ9pzk BZejwtu3WP1WylcL9KGIQXWcrUk0xcJGxtcPhAHM= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from cc-smtpout3.netcologne.de (cc-smtpout3.netcologne.de [89.1.8.213]) by sourceware.org (Postfix) with ESMTPS id 4A6EA3851C16; Sat, 23 May 2020 17:08:22 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 4A6EA3851C16 Received: from cc-smtpin1.netcologne.de (cc-smtpin1.netcologne.de [89.1.8.201]) by cc-smtpout3.netcologne.de (Postfix) with ESMTP id BE37412AC0; Sat, 23 May 2020 19:08:20 +0200 (CEST) Received: from localhost (localhost [127.0.0.1]) by cc-smtpin1.netcologne.de (Postfix) with ESMTP id B0E9711D8D; Sat, 23 May 2020 19:08:20 +0200 (CEST) Received: from [2001:4dd7:7821:0:f672:738:36da:e63a] (helo=cc-smtpin1.netcologne.de) by localhost with ESMTP (eXpurgate 4.11.6) (envelope-from ) id 5ec95884-45d8-7f0000012729-7f000001cd88-1 for ; Sat, 23 May 2020 19:08:20 +0200 Received: from linux-p51k.fritz.box (2001-4dd7-7821-0-f672-738-36da-e63a.ipv6dyn.netcologne.de [IPv6:2001:4dd7:7821:0:f672:738:36da:e63a]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by cc-smtpin1.netcologne.de (Postfix) with ESMTPSA; Sat, 23 May 2020 19:08:18 +0200 (CEST) To: "fortran@gcc.gnu.org" , gcc-patches Subject: [patch, fortran, committed] Fix PR 95191, hang on invalid ID for WAIT Message-ID: Date: Sat, 23 May 2020 19:08:18 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.8.0 MIME-Version: 1.0 Content-Language: de-DE X-Spam-Status: No, score=-10.4 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, 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: Thomas Koenig via Gcc-patches From: Thomas Koenig Reply-To: Thomas Koenig Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" Hello world, I have just committed as obvious and simple the attached patch - adding an early error return. This is a 9/10/11 Regression, so I will commit to the other branches in a few days. Regards Thhomas Fixes a hang on an invalid ID in a WAIT statement. gcc/fortran/ChangeLog: 2020-05-23 Thomas Koenig PR libfortran/95191 * libgfortran.h (libgfortran_error_codes): Add LIBERROR_BAD_WAIT_ID. libgfortran/ChangeLog: 2020-05-23 Thomas Koenig PR libfortran/95191 * io/async.c (async_wait_id): Generate error if ID is higher than the highest current ID. * runtime/error.c (translate_error): Handle LIBERROR_BAD_WAIT_ID. libgomp/ChangeLog: 2020-05-23 Thomas Koenig PR libfortran/95191 * testsuite/libgomp.fortran/async_io_9.f90: New test. diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h index d097caa4a96..6a9139c98fc 100644 --- a/gcc/fortran/libgfortran.h +++ b/gcc/fortran/libgfortran.h @@ -124,6 +124,7 @@ typedef enum LIBERROR_SHORT_RECORD, LIBERROR_CORRUPT_FILE, LIBERROR_INQUIRE_INTERNAL_UNIT, /* Must be different from STAT_STOPPED_IMAGE. */ + LIBERROR_BAD_WAIT_ID, LIBERROR_LAST /* Not a real error, the last error # + 1. */ } libgfortran_error_codes; diff --git a/libgfortran/io/async.c b/libgfortran/io/async.c index 63b9158c0ba..1bf38e9c0ff 100644 --- a/libgfortran/io/async.c +++ b/libgfortran/io/async.c @@ -424,6 +424,13 @@ async_wait_id (st_parameter_common *cmp, async_unit *au, int i) } LOCK (&au->lock); + if (i > au->id.high) + { + generate_error_common (cmp, LIBERROR_BAD_WAIT_ID, NULL); + UNLOCK (&au->lock); + return true; + } + NOTE ("Waiting for id %d", i); if (au->id.waiting < i) au->id.waiting = i; diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c index 9ed5d566eb6..ff6b852a07c 100644 --- a/libgfortran/runtime/error.c +++ b/libgfortran/runtime/error.c @@ -660,6 +660,10 @@ translate_error (int code) p = "Inquire statement identifies an internal file"; break; + case LIBERROR_BAD_WAIT_ID: + p = "Bad ID in WAIT statement"; + break; + default: p = "Unknown error code"; break; diff --git a/libgomp/testsuite/libgomp.fortran/async_io_9.f90 b/libgomp/testsuite/libgomp.fortran/async_io_9.f90 new file mode 100644 index 00000000000..2dc111c3967 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/async_io_9.f90 @@ -0,0 +1,20 @@ +! { dg-do run } +! PR 95191 - this used to hang. +! Original test case by Bill Long. +program test + real a(10000) + integer my_id + integer bad_id + integer :: iostat + character (len=100) :: iomsg + data my_id /1/ + data bad_id /2/ + a = 1. + open (unit=10, file='test.dat', form='unformatted', & + & asynchronous='yes') + write (unit=10, asynchronous='yes', id=my_id) a + iomsg = "" + wait (unit=10, id=bad_id, iostat=iostat, iomsg=iomsg) + if (iostat == 0 .or. iomsg /= "Bad ID in WAIT statement") stop 1 + close (unit=10, status='delete') +end program test