From patchwork Sat Feb 10 17:46:57 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Steve Kargl X-Patchwork-Id: 871688 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-473017-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="X9Z0Mtn2"; 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 3zdzsG6ml9z9s82 for ; Sun, 11 Feb 2018 04:47:14 +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:date :from:to:subject:message-id:reply-to:mime-version:content-type; q=dns; s=default; b=x5P3tSoABBFN9Q/UbksVySf13Ib/S3PCNK5QUharh0p 3/88vH30+SgChcaEbo+kyVdN2j/dnmnLWVkAxdgJkEb7tMFoaEDij5ZDOrKWLyEq RU0UZ+nSJlp2n6SHFjI5H2Ewsn3URHboarQ+vpEBUHmFrl/m4nk5OGyUAzpuoWBs = 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:date :from:to:subject:message-id:reply-to:mime-version:content-type; s=default; bh=CPkgrkCx2Htx+i/eLeiF/01EPj0=; b=X9Z0Mtn26pJitctFt a6Oj31WE0nnE1Jx1ejO2X8/pVOF2ddF98m8fWJr17YbKmDcKhw3jL6WZRr9X8Fc7 51kPMlP+3FxLSv+HqlbZwOU8O5sTqU3INbz9EmxeabLdCoCuKI5nOllFzyT7YIfJ UTVEzrGOtr0B+2Kt0ZpHR2L4Tg= Received: (qmail 56366 invoked by alias); 10 Feb 2018 17:47:02 -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 56347 invoked by uid 89); 10 Feb 2018 17:47:01 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-9.4 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, KAM_LAZY_DOMAIN_SECURITY, RCVD_IN_DNSWL_NONE, T_RP_MATCHES_RCVD autolearn=ham version=3.3.2 spammy= X-Spam-User: qpsmtpd, 2 recipients X-HELO: troutmask.apl.washington.edu Received: from troutmask.apl.washington.edu (HELO troutmask.apl.washington.edu) (128.95.76.21) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sat, 10 Feb 2018 17:46:59 +0000 Received: from troutmask.apl.washington.edu (localhost [127.0.0.1]) by troutmask.apl.washington.edu (8.15.2/8.15.2) with ESMTPS id w1AHkvNE016751 (version=TLSv1.2 cipher=DHE-RSA-AES256-GCM-SHA384 bits=256 verify=NO); Sat, 10 Feb 2018 09:46:57 -0800 (PST) (envelope-from sgk@troutmask.apl.washington.edu) Received: (from sgk@localhost) by troutmask.apl.washington.edu (8.15.2/8.15.2/Submit) id w1AHkvZ0016750; Sat, 10 Feb 2018 09:46:57 -0800 (PST) (envelope-from sgk) Date: Sat, 10 Feb 2018 09:46:57 -0800 From: Steve Kargl To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH] Fix handling of arguments in statement functions Message-ID: <20180210174657.GA16695@troutmask.apl.washington.edu> Reply-To: sgk@troutmask.apl.washington.edu MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.9.2 (2017-12-15) All, The attach patch address 3 issues with statement functions. First, a dummy argument in a statement function declarations acquires only its type and type parameters from the containing scope. All attributes should be ignores. The first fix for PR fortran/84276 disables a check for the INTENT(INOUT,OUT) attribute. The second fix for PR fortran/54223 disables a check for missing OPTIONAL arguments as an argument to a statement function cannot be optional. In reviewing the bugs for statement functions, I came across PR fortran/35229. There is a long audit trail, but I have come to agree with comment #3 from FX. I have taken his suggested patch for updating the error message. Note, this issue is 10 years old, and AFAIK, no one has sent a duplicate PR or an email to fortran@gnu complaining about the current error message. The new error message simply gives a better locus. OK to commit? Release Manager, I can hold the patch until after 8.0/1 is released, but it is highly unlikely that this patch will cause a regression and it does fix two ICE. 2018-02-10 Steven G. Kargl PR fortran/54223 PR fortran/84276 * interface.c (compare_actual_formal): Add in_statement_function bool parameter. Skip check of INTENT attribute for statement functions. Arguments to a statement function cannot be optional, issue error for missing argument. (gfc_procedure_use, gfc_ppc_use, gfc_arglist_matches_symbol): Use in_statement_function. 2018-02-10 Steven G. Kargl PR fortran/54223 PR fortran/84276 * gfortran.dg/statement_function_1.f90: New test. * gfortran.dg/statement_function_3.f90: New test. PR fortran/35299 * gfortran.dg/statement_function_3.f: New test. Index: gcc/fortran/interface.c =================================================================== --- gcc/fortran/interface.c (revision 257464) +++ gcc/fortran/interface.c (working copy) @@ -2835,7 +2835,8 @@ lookup_arg_fuzzy (const char *arg, gfc_formal_arglist static bool compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, - int ranks_must_agree, int is_elemental, locus *where) + int ranks_must_agree, int is_elemental, + bool in_statement_function, locus *where) { gfc_actual_arglist **new_arg, *a, *actual; gfc_formal_arglist *f; @@ -3204,8 +3205,9 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_fo } /* Check intent = OUT/INOUT for definable actual argument. */ - if ((f->sym->attr.intent == INTENT_OUT - || f->sym->attr.intent == INTENT_INOUT)) + if (!in_statement_function + && (f->sym->attr.intent == INTENT_OUT + || f->sym->attr.intent == INTENT_INOUT)) { const char* context = (where ? _("actual argument to INTENT = OUT/INOUT") @@ -3310,7 +3312,8 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_fo "at %L", where); return false; } - if (!f->sym->attr.optional) + if (!f->sym->attr.optional + || (in_statement_function && f->sym->attr.optional)) { if (where) gfc_error ("Missing actual argument for argument %qs at %L", @@ -3598,6 +3601,7 @@ check_intents (gfc_formal_arglist *f, gfc_actual_argli bool gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) { + gfc_actual_arglist *a; gfc_formal_arglist *dummy_args; /* Warn about calls with an implicit interface. Special case @@ -3631,8 +3635,6 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist if (sym->attr.if_source == IFSRC_UNKNOWN) { - gfc_actual_arglist *a; - if (sym->attr.pointer) { gfc_error ("The pointer object %qs at %L must have an explicit " @@ -3724,9 +3726,12 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist dummy_args = gfc_sym_get_dummy_args (sym); - if (!compare_actual_formal (ap, dummy_args, 0, sym->attr.elemental, where)) + /* For a statement function, check that types and type parameters of actual + arguments and dummy arguments match. */ + if (!compare_actual_formal (ap, dummy_args, 0, sym->attr.elemental, + sym->attr.proc == PROC_ST_FUNCTION, where)) return false; - + if (!check_intents (dummy_args, *ap)) return false; @@ -3773,7 +3778,7 @@ gfc_ppc_use (gfc_component *comp, gfc_actual_arglist * } if (!compare_actual_formal (ap, comp->ts.interface->formal, 0, - comp->attr.elemental, where)) + comp->attr.elemental, false, where)) return; check_intents (comp->ts.interface->formal, *ap); @@ -3798,7 +3803,7 @@ gfc_arglist_matches_symbol (gfc_actual_arglist** args, dummy_args = gfc_sym_get_dummy_args (sym); r = !sym->attr.elemental; - if (compare_actual_formal (args, dummy_args, r, !r, NULL)) + if (compare_actual_formal (args, dummy_args, r, !r, false, NULL)) { check_intents (dummy_args, *args); if (warn_aliasing) Index: gcc/testsuite/gfortran.dg/statement_function_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/statement_function_1.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/statement_function_1.f90 (working copy) @@ -0,0 +1,28 @@ +! { dg-do compile } +! PR fortran/84276 + subroutine stepns(hh, h, s, w) + real, intent(inout) :: h, hh, s + real, intent(out) :: w + real :: qofs + integer i + qofs(s) = s + w = qofs(hh + h) + i = 42 + w = qofs(i) ! { dg-error "Type mismatch in argument" } + end subroutine stepns + + subroutine step(hh, h, s, w) + real, intent(inout) :: h, hh, s + real, intent(out) :: w + real :: qofs + integer i + qofs(s, i) = i * s + i = 42 + w = qofs(hh, i) +! +! The following line should cause an error, because keywords are not +! allowed in a function with an implicit interface. +! + w = qofs(i = i, s = hh) + end subroutine step +! { dg-prune-output " Obsolescent feature" } Index: gcc/testsuite/gfortran.dg/statement_function_2.f90 =================================================================== --- gcc/testsuite/gfortran.dg/statement_function_2.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/statement_function_2.f90 (working copy) @@ -0,0 +1,26 @@ +! { dg-do compile } +! PR fortran/54223 +subroutine r(d) + implicit none + integer, optional :: d + integer :: h, q + q(d) = d + 1 ! statement function statement + h = q(d) +end subroutine r + +subroutine s(x) + implicit none + integer, optional :: x + integer :: g, z + g(x) = x + 1 ! statement function statement + z = g() ! { dg-error "Missing actual argument" } +end subroutine s + +subroutine t(a) + implicit none + integer :: a + integer :: f, y + f(a) = a + 1 ! statement function statement + y = f() ! { dg-error "Missing actual argument" } +end subroutine t +! { dg-prune-output " Obsolescent feature" } Index: gcc/testsuite/gfortran.dg/statement_function_3.f =================================================================== --- gcc/testsuite/gfortran.dg/statement_function_3.f (nonexistent) +++ gcc/testsuite/gfortran.dg/statement_function_3.f (working copy) @@ -0,0 +1,15 @@ +! { dg-do compile } +! PR fortran/35299 + subroutine phtod(e,n,i,h) + dimension e(n) + hstar(e,b)=b**.4*((1.25*fun(-e/40)+.18)) ! { dg-error "must be scalar" } + a = 1. + h = hstar(e(i-1), a) + end + + function fun(a) + real a(*) + fun = 42 + end +! { dg-prune-output " Obsolescent feature" } +