From patchwork Wed Oct 5 04:49:59 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jerry DeLisle X-Patchwork-Id: 678350 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 3spjyt3kJZz9sD5 for ; Wed, 5 Oct 2016 15:50:45 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=f9ioTB/9; 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:from :subject:cc:to:message-id:date:mime-version:content-type :content-transfer-encoding; q=dns; s=default; b=V/ShuZ2o3Mp1Pgxm FBzeMyPTjGP6Pk1lKDrG5e21cJwr2MCd3H25bJ7EeiBfRs3vBFCybFQzAi1bzBli 80EjyLBk7uX4wIYUTiqu5xeEtGA6hgCBMQKQqKcq3aKLyYzHPsMIlH3rmLgNt9IL jhKYrrVJ/KxFlRfa5g6GadGzFsU= 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:from :subject:cc:to:message-id:date:mime-version:content-type :content-transfer-encoding; s=default; bh=gR1s6DSLU7SBDwajQhUJFV m20e0=; b=f9ioTB/9EkbMR+F93vjHl6lzs/kemXV7nwD+8yLRlC9duVQ7zYrQQ/ YJmJ3eFLk4TVEtNMkM5/o7khscPS8pEgVD1gzjYbNx1V7I8djQd1OmIn45jPXutA rH44eg2U8vk/8aY5/qqj3w9aA6F3RGmDenkaaoSCxjDF7OAe+XL5A= Received: (qmail 126076 invoked by alias); 5 Oct 2016 04:50:30 -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 125951 invoked by uid 89); 5 Oct 2016 04:50:18 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-4.3 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RP_MATCHES_RCVD, SPF_PASS autolearn=ham version=3.3.2 spammy= X-Spam-User: qpsmtpd, 2 recipients X-HELO: mtaout004-public.msg.strl.va.charter.net Received: from mtaout004-public.msg.strl.va.charter.net (HELO mtaout004-public.msg.strl.va.charter.net) (68.114.190.29) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Oct 2016 04:50:07 +0000 Received: from impout004 ([68.114.189.19]) by mtaout004.msg.strl.va.charter.net (InterMail vM.9.00.023.01 201-2473-194) with ESMTP id <20161005045005.XPYH3685.mtaout004.msg.strl.va.charter.net@impout004>; Tue, 4 Oct 2016 23:50:05 -0500 Received: from amda8.localdomain ([96.41.215.23]) by impout004 with charter.net id rgq41t0070Wrkg001gq4eU; Tue, 04 Oct 2016 23:50:05 -0500 X-Authority-Analysis: v=2.1 cv=Zb6TN6lA c=1 sm=1 tr=0 a=salB9WdMPIDduBH7JsZfrA==:117 a=salB9WdMPIDduBH7JsZfrA==:17 a=L9H7d07YOLsA:10 a=9cW_t1CCXrUA:10 a=s5jvgZ67dGcA:10 a=IkcTkHD0fZMA:10 a=mDV3o1hIAAAA:8 a=zH2oFKi0xBPiTZgV-zQA:9 a=QEXdDO2ut3YA:10 a=_FVE-zBwftR9WsbkzFJk:22 X-Auth-id: anZkZWxpc2xlQGNoYXJ0ZXIubmV0 X-Mozilla-News-Host: news://news.eternal-september.org:119 From: JerryD Subject: [Patch, libgfortran] Inquire internal unit within child dtio procedure Cc: GCC Patches To: "fortran@gcc.gnu.org" Message-ID: Date: Tue, 4 Oct 2016 21:49:59 -0700 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:45.0) Gecko/20100101 Thunderbird/45.2.0 MIME-Version: 1.0 Committed as trivial. Reported on c.l.f Regression tested on x86-64. Regards, Jerry 2016-10-04 Jerry DeLisle io/inquire.c (inquire_via_unit): Add check for internal unit passed into child IO procedure. 2016-10-04 Jerry DeLisle * gfortran.dg/dtio_15.f90: New test. r240766 = d59520df9fe83f1a9aea7e766cef52bf6ec790df (refs/remotes/svn/trunk) A gcc/testsuite/gfortran.dg/dtio_15.f90 M libgfortran/ChangeLog M libgfortran/io/inquire.c if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0) diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c index 2bb518b6..7751b8df 100644 --- a/libgfortran/io/inquire.c +++ b/libgfortran/io/inquire.c @@ -41,7 +41,9 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u) const char *p; GFC_INTEGER_4 cf = iqp->common.flags; - if (iqp->common.unit == GFC_INTERNAL_UNIT || iqp->common.unit == GFC_INTERNAL_UNIT4) + if (iqp->common.unit == GFC_INTERNAL_UNIT || + iqp->common.unit == GFC_INTERNAL_UNIT4 || + u->internal_unit_kind != 0) generate_error (&iqp->common, LIBERROR_INQUIRE_INTERNAL_UNIT, NULL);