From patchwork Thu Feb 15 20:03:55 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Janus Weil X-Patchwork-Id: 874111 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-473357-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.b="sfBd1u6b"; dkim-atps=neutral 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 3zj6fz2r8fz9t3M for ; Fri, 16 Feb 2018 07:04:11 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :mime-version:from:date:message-id:subject:to:content-type; q= dns; s=default; b=nMO+EQc5P4E2NuQNFoxKIMThL32dZjS8ASK53G2ngutPrd dq5qe8thRQLsF7eb/4WXNNP7uMKb5JzzCmx7hLzkotQTwAGZyqn8CDZX8du+eHZ5 MMMHDvnDUYld9UWaRFt30DB/L0Ya3vRzhQ4uCg5jIEwGrdImaaGcgZgVtqNtk= 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 :mime-version:from:date:message-id:subject:to:content-type; s= default; bh=6AXW4JisOwmfD8eAnAwnoUXNG4k=; b=sfBd1u6bWQEUh2K8YVqy yTFJXVrAG0ojAVawLDoW1mVuxJIeysTwhgTUO7prmZIG0zbc2nsiJDtlW6MDe7DW UkasRue1rh4QtJFjP2PZD18vUrUguf6+2dVlxd9aNWnxj+KdDTTYIErn04frGW+/ 7pQFxN1Voj3cySETb+4DYbU= Received: (qmail 49256 invoked by alias); 15 Feb 2018 20:04:00 -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 49231 invoked by uid 89); 15 Feb 2018 20:03:59 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-10.0 required=5.0 tests=AWL, BAYES_00, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=curing X-Spam-User: qpsmtpd, 2 recipients X-HELO: mail-yw0-f182.google.com Received: from mail-yw0-f182.google.com (HELO mail-yw0-f182.google.com) (209.85.161.182) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 15 Feb 2018 20:03:57 +0000 Received: by mail-yw0-f182.google.com with SMTP id b16so597782ywh.12; Thu, 15 Feb 2018 12:03:57 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:mime-version:sender:from:date:message-id:subject :to; bh=guj3aW21MIzbIR1MO30LNv8XYObG56q8V0u5uiV7pbw=; b=myZ0BjQIPc/rIYA9cvRsEKUF1IvPaOB5LiI4zAaFXxPgmrhwNPH8pgm6KXQqDg0rJj 3p4nPa52SxL3x45AZCHl86wZu9vsWkriTjzjNaYGdQlWKky31xAGdURgq8YP+54CzXpB ytkWTTfls4bdq438nyqU1jH/8Y0FdHfTycR45RKkyIFToeskJPNDunfRfcQ/8rID4Z5D 7KPDzdKCW2qMsSvg6XpiqWPS7ZqIEwStwgILlrHg65J23nZCsksMHAHj4hmf2lxPUEcm P+AKH3EI9a8bU3xRdekPBczzAiFs9f5Li/muD7AWzYOczd8OakEIFmC+Kw7gI8vrOG1P Jo1w== X-Gm-Message-State: APf1xPCJNVfwAv7CucWKLM3Zh8qkxF8kFB4DOlqGDFwVHnUO98PjOCkQ zlAZ1z0KG0NFfze0tumHpqYnF1KhYi9/gDFICD+fUQ== X-Google-Smtp-Source: AH8x225wAD0loaRnLTVq8fRqngYLuusT93EAyknNHOgjTJ9eiQwGtSV9U1MSJiuUV7K8JtbK3kx/4IliUCknjHbGnAY= X-Received: by 10.129.198.1 with SMTP id l1mr3015878ywi.398.1518725035631; Thu, 15 Feb 2018 12:03:55 -0800 (PST) MIME-Version: 1.0 Received: by 10.129.146.71 with HTTP; Thu, 15 Feb 2018 12:03:55 -0800 (PST) From: Janus Weil Date: Thu, 15 Feb 2018 21:03:55 +0100 Message-ID: Subject: [Patch, Fortran, F03] PR 84409: check DTIO arguments for character len To: gfortran , gcc-patches Hi all, attached is another simple patch for an accepts-invalid problem (this time concerning DTIO), also curing an invalid test case. Regtests cleanly on x86_64-linux-gnu. Ok for trunk? Cheers, Janus 2018-02-15 Janus Weil PR fortran/84409 * interface.c (check_dtio_arg_TKR_intent): Add a check for character length. 2018-02-15 Janus Weil PR fortran/84409 * gfortran.dg/dtio_21.f03: Add an error message. * gfortran.dg/dtio_22.f90: Fix invalid test case. Index: gcc/fortran/interface.c =================================================================== --- gcc/fortran/interface.c (revision 257672) +++ gcc/fortran/interface.c (working copy) @@ -4702,6 +4702,10 @@ check_dtio_arg_TKR_intent (gfc_symbol *fsym, bool gfc_error ("DTIO dummy argument at %L must be an " "ASSUMED SHAPE ARRAY", &fsym->declared_at); + if (type == BT_CHARACTER && fsym->ts.u.cl->length != NULL) + gfc_error ("DTIO character argument at %L must have assumed length", + &fsym->declared_at); + if (fsym->attr.intent != intent) gfc_error ("DTIO dummy argument at %L must have INTENT %s", &fsym->declared_at, gfc_code2string (intents, (int)intent)); Index: gcc/testsuite/gfortran.dg/dtio_21.f90 =================================================================== --- gcc/testsuite/gfortran.dg/dtio_21.f90 (revision 257672) +++ gcc/testsuite/gfortran.dg/dtio_21.f90 (working copy) @@ -19,10 +19,10 @@ program p allocate(z2) print *, z2 contains - subroutine wf2(this, a, b, c, d, e) + subroutine wf2(this, a, b, c, d, e) ! { dg-error "must have assumed length" } class(t2), intent(in) :: this integer, intent(in) :: a - character, intent(in) :: b + character(*), intent(in) :: b integer, intent(in) :: c(:) integer, intent(out) :: d character, intent(inout) :: e Index: gcc/testsuite/gfortran.dg/dtio_22.f90 =================================================================== --- gcc/testsuite/gfortran.dg/dtio_22.f90 (revision 257672) +++ gcc/testsuite/gfortran.dg/dtio_22.f90 (working copy) @@ -15,10 +15,10 @@ contains subroutine wf(this, unit, b, c, iostat, iomsg) class(t), intent(in) :: this integer, intent(in) :: unit - character, intent(in) :: b + character(*), intent(in) :: b integer, intent(in) :: c(:) integer, intent(out) :: iostat - character, intent(inout) :: iomsg + character(*), intent(inout) :: iomsg write (unit, "(i3)", IOSTAT=iostat, IOMSG=iomsg) this%i end subroutine end