From patchwork Sat Jan 5 04:07:02 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Steve Kargl X-Patchwork-Id: 1020950 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-493426-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=troutmask.apl.washington.edu Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="pr/a9plE"; 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 43Wp5P1n1Yz9s7T for ; Sat, 5 Jan 2019 15:07:18 +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=QmWlYzmqpWSQoHVzyzwf6Kkhov1VE+g2IXzk4JCSWW3 zYC92uuV2Se/L17jqj7B64ZCNp2M80MbBEwr3fOFUJO7Rt6IxnawDgSQZLn9Hr6n Jog0Wkw9HnQIMs4mWF2S/gr2y0V8K4wtGSzxcJVoaRMqIIQSBxHM00EGgK7IP0qE = 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=6Mpuj/FzV3AnyqjeGmX/tjdn81Q=; b=pr/a9plEjz/5MHMC5 pt/c1HCPb3FPLz8cPity6QkJKqW44F/uVNVizrY+xRg7/Y16n0nmyHxBvdG0L7/h 1pQhyQSb6t4drwEiJqQ7VuLliM4uSfL1PA4Z9WVoWhsxwmZ1dX1t1OoMZNXy9rbg bLIHC0u3TykNhdnGTRCJdSSgtc= Received: (qmail 50551 invoked by alias); 5 Jan 2019 04:07:08 -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 50529 invoked by uid 89); 5 Jan 2019 04:07:08 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-10.1 required=5.0 tests=BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, KAM_LAZY_DOMAIN_SECURITY autolearn=ham version=3.3.2 spammy=mixed, 002, ordinary, UD:ieee_arithmetic.F90 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, 05 Jan 2019 04:07:04 +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 x054728q098064 (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384 bits=256 verify=NO); Fri, 4 Jan 2019 20:07:03 -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 x05472W0098063; Fri, 4 Jan 2019 20:07:02 -0800 (PST) (envelope-from sgk) Date: Fri, 4 Jan 2019 20:07:02 -0800 From: Steve Kargl To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH] PR fortran/69101 -- IEEE_SELECTED_REAL_KIND part I Message-ID: <20190105040702.GA98056@troutmask.apl.washington.edu> Reply-To: sgk@troutmask.apl.washington.edu MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.10.1 (2018-07-13) 2019-01-04 Steven G. Kargl PR fortran/69101 * expr.c (gfc_check_init_expr): If errors were emitted during simplification of ieee_selected_real_kind(), clear any additional errors anre return false. * simplify.c (simplify_ieee_selected_real_kind): make ieee_selected_real_kind() generic in an initialization expression, and check for conformance of actual arguments. 2019-01-04 Steven G. Kargl PR fortran/69101 * gfortran.dg/ieee/ieee_7.f90: Remove invalid code. * gfortran.dg/ieee/pr69101_1.f90: Check for errors in actual arguments of ieee_selected_real_kind(). * gfortran.dg/ieee/pr69101_2.f90: Test -std=f2003. RADIX was added in F2008. TL;DR version The attached patch fixes ieee_selected_real_kind (ISRK) when used in an initialization expression, where either keywords are mixed up compared to their position or the actual arguments are not default integer kind. It does not fix the use of ISRK in an ordinary expression. Test on i586-*-freebsd and x86_64-*-freebsd. OK to commit? Long version ISRK is a function with a generic interface. It is available from the ieee_arithmetic intrinsic module. The problem is that the Fortran standard has specified a generic interface that is not expressable in Fortran; and hence, gfortran cannot express it in the file ieee_arithmetic.F90. If one thinks about the situation, ISRK is then neither a module procedure nor an intrinsic subprogram. This patch expands upon the original simplification process when an ISRK is seen. It inspects the actual arguments for keywords and provides a proper ordering. It checks that each argument, if present, is a scalar integer entity, and whether -std=F2008 or later is in effect. Because gfortran is performing simplification in an initialization expression, queuing error messages with gfc_error() is disabled. Thus, errors are emitted with gfc_error_now(). If one or more error is emitted, the portion of the patch in expr.c short circuits simplification to prevent run-on errors. It is now possible to do program foo use ieee_arithmetic, only : isrk => ieee_selected_real_kind integer, parameter :: rknd = isrk(radix=2_1, p=6_8, r=200_2) print *, rknd end program foo Note, ISRK must be available from the module to allow the renaming that occurs above, but ideally gfortran should use its machinery for intrinsic function. The patch only fixes the use in initialization expression. If ISRK appears in a non-initialization expression, gfortran keels over. Fixes that is Part II of addressing shortcoming with ISRK. Finally, things are going to even more interesting when F2018's ieee_real() and ieee_int() are added to gfortran. Index: gcc/fortran/expr.c =================================================================== --- gcc/fortran/expr.c (revision 267591) +++ gcc/fortran/expr.c (working copy) @@ -2768,11 +2768,20 @@ gfc_check_init_expr (gfc_expr *e) mod = sym->generic->sym->from_intmod; if (mod == INTMOD_IEEE_ARITHMETIC || mod == INTMOD_IEEE_EXCEPTIONS) { + int ecnt; + gfc_expr *new_expr = gfc_simplify_ieee_functions (e); if (new_expr) { gfc_replace_expr (e, new_expr); t = true; + break; + } + gfc_get_errors (NULL, &ecnt); + if (ecnt > 0) + { + t = false; + gfc_clear_error (); break; } } Index: gcc/fortran/simplify.c =================================================================== --- gcc/fortran/simplify.c (revision 267591) +++ gcc/fortran/simplify.c (working copy) @@ -8521,25 +8521,129 @@ gfc_simplify_compiler_version (void) /* Simplification routines for intrinsics of IEEE modules. */ +/* IEEE_SELECTED_REAL_KIND is generic, but cannot be specified in the + intrinsic module ieee_arithmetic.mod due to ambiguous interfaces. When + it appears in an initialization expression, the checking must be done + here. */ + gfc_expr * simplify_ieee_selected_real_kind (gfc_expr *expr) { - gfc_actual_arglist *arg; - gfc_expr *p = NULL, *q = NULL, *rdx = NULL; + gfc_actual_arglist *arg0, *arg1, *arg2; + gfc_expr *p, *r, *rdx; - arg = expr->value.function.actual; - p = arg->expr; - if (arg->next) + arg1 = arg2 = NULL; + p = r = rdx = NULL; + + arg0 = expr->value.function.actual; + if (arg0->next) + { + arg1 = arg0->next; + if (arg1->next) arg2 = arg1->next; + } + + if (!arg0->expr && arg1 && !arg1->expr && arg2 && !arg2->expr) + { + gfc_error_now ("At least one of P, R, or RADIX must be present in " + "IEEE_SELECTED_REAL_KIND at %C"); + gfc_clear_error (); + return NULL; + } + + /* Look at first argument. */ + if (!arg0->name || strcmp(arg0->name, "p") == 0) + p = arg0->expr; + else if (strcmp(arg0->name, "r") == 0) + r = arg0->expr; + else if (strcmp(arg0->name, "radix") == 0) + rdx = arg0->expr; + else + goto invalid; + + /* Look at second argument, if it exists. */ + if (arg1) { - q = arg->next->expr; - if (arg->next->next) - rdx = arg->next->next->expr; + if (!arg1->name || strcmp(arg1->name, "r") == 0) + { + if (r) + return NULL; + r = arg1->expr; + } + else if (strcmp(arg1->name, "p") == 0) + { + if (p) + return NULL; + p = arg1->expr; + } + else if (strcmp(arg1->name, "radix") == 0) + { + if (rdx) + return NULL; + rdx = arg1->expr; + } + else + goto invalid; } - /* Currently, if IEEE is supported and this module is built, it means - all our floating-point types conform to IEEE. Hence, we simply handle - IEEE_SELECTED_REAL_KIND like SELECTED_REAL_KIND. */ - return gfc_simplify_selected_real_kind (p, q, rdx); + /* Look at third argument, if it exists. */ + if (arg2) + { + if (!arg2->name || strcmp(arg2->name, "radix") == 0) + { + if (rdx) + return NULL; + rdx = arg2->expr; + } + else if (strcmp(arg2->name, "p") == 0) + { + if (p) + return NULL; + p = arg2->expr; + } + else if (strcmp(arg2->name, "r") == 0) + { + if (r) + return NULL; + r = arg2->expr; + } + else + goto invalid; + } + + /* Check for scalar integer expressions. */ + if (p && (p->ts.type != BT_INTEGER || p->rank != 0)) + goto mismatch; + + if (r && (r->ts.type != BT_INTEGER || r->rank != 0)) + goto mismatch; + + if (rdx) + { + if (GFC_STD_F2008 & ~gfc_option.allow_std) + { + gfc_error_now ("Fortran 2008: RADIX argument specified in " + "IEEE_SELECTED_REAL_KIND at %C"); + return NULL; + } + + if (rdx->ts.type != BT_INTEGER || rdx->rank != 0) + goto mismatch; + } + + return gfc_simplify_selected_real_kind (p, r, rdx); + +mismatch: + + gfc_error_now ("Scalar integer argument expected in " + "IEEE_SELECTED_REAL_KIND at %C"); + return NULL; + +invalid: + + /* This should be unreachable. */ + gfc_fatal_error ("Invalid uses of IEEE_SELECTED_REAL_KIND at %C"); + return NULL; + } gfc_expr * Index: gcc/testsuite/gfortran.dg/ieee/ieee_7.f90 =================================================================== --- gcc/testsuite/gfortran.dg/ieee/ieee_7.f90 (revision 267591) +++ gcc/testsuite/gfortran.dg/ieee/ieee_7.f90 (working copy) @@ -11,7 +11,6 @@ ! Test IEEE_SELECTED_REAL_KIND in specification expressions - integer(kind=ieee_selected_real_kind()) :: i1 integer(kind=ieee_selected_real_kind(10)) :: i2 integer(kind=ieee_selected_real_kind(10,10)) :: i3 integer(kind=ieee_selected_real_kind(10,10,2)) :: i4 @@ -19,7 +18,6 @@ ! Test IEEE_SELECTED_REAL_KIND if (ieee_support_datatype(0.)) then - if (ieee_selected_real_kind() /= kind(0.)) STOP 1 if (ieee_selected_real_kind(0) /= kind(0.)) STOP 2 if (ieee_selected_real_kind(0,0) /= kind(0.)) STOP 3 if (ieee_selected_real_kind(0,0,2) /= kind(0.)) STOP 4 Index: gcc/testsuite/gfortran.dg/ieee/pr69101_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/ieee/pr69101_1.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/ieee/pr69101_1.f90 (working copy) @@ -0,0 +1,10 @@ +! { dg-do compile } +program foo + use ieee_arithmetic + implicit none + integer, parameter :: n(3) = [ 1, 2, 3] + integer, parameter :: i1 = ieee_selected_real_kind() ! { dg-error "must be present in" } + integer, parameter :: j2 = ieee_selected_real_kind(p=6,p=7) ! { dg-error "has already appeared in" } + integer, parameter :: j3 = ieee_selected_real_kind(r=7.) ! { dg-error "Scalar integer argument" } + integer, parameter :: j4 = ieee_selected_real_kind(n) ! { dg-error "Scalar integer argument" } +end program foo Index: gcc/testsuite/gfortran.dg/ieee/pr69101_2.f90 =================================================================== --- gcc/testsuite/gfortran.dg/ieee/pr69101_2.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/ieee/pr69101_2.f90 (working copy) @@ -0,0 +1,7 @@ +! { dg-do compile } +! { dg-additional-options "-std=f2003" } +program foo + use ieee_arithmetic + implicit none + integer, parameter :: jr = ieee_selected_real_kind(radix=2) ! { dg-error "RADIX argument" } +end program foo