From patchwork Thu Apr 22 21:21:45 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 1469413 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=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces@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.a=rsa-sha256 header.s=default header.b=kQT1dbPQ; dkim-atps=neutral Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (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 4FR9NL551dz9sVq for ; Fri, 23 Apr 2021 07:21:53 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 915713A63819; Thu, 22 Apr 2021 21:21:50 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 915713A63819 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1619126510; bh=YRrj9VbgRfNJG4aOj5fylAZsUbyjgadMgCKwJ6teT3o=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=kQT1dbPQDX2r5B/zmWien/2moGV/vJQtznrHBgWf5S/hr60DUouVZWa01wqGo7wdX so22o0U+IhclMmsU0KTRQrpmEWrDP3ACxZ2vO+svX4xAKASgWqJYxdtYQluhDXZY+c qi+ou1s4PBQcVRM3F7Ovbbz/zOEDhW2iZD1TjB9k= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mout.gmx.net (mout.gmx.net [212.227.17.20]) by sourceware.org (Postfix) with ESMTPS id 3EF233A6380E; Thu, 22 Apr 2021 21:21:47 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 3EF233A6380E X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [93.207.84.42] ([93.207.84.42]) by web-mail.gmx.net (3c-app-gmx-bap45.server.lan [172.19.172.115]) (via HTTP); Thu, 22 Apr 2021 23:21:45 +0200 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: [Patch] PR fortran/100154 - [9/10/11/12 Regression] ICE in gfc_conv_procedure_call, at fortran/trans-expr.c:6131 Date: Thu, 22 Apr 2021 23:21:45 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:nSlA/2DlHlZf1Any/NLGQisYFxVdKcwJAJn/AgtqJfy6/+j3bEZbHP3WsB7Gi3YNi1YQq WKGezyRQBfbnKv8uDM1jPhMJiyDXmBZHamcYRMT7A8xLrrlKneweOeAP+rymE5Swb18XQt2LKAkd jakcDnAuP+3xrVtEmwKJEPNs5Gb4If2mwGN2JKZaBjHCBuUWkdg20tI0wSLDd1Vce5GBaIWlwn1L kYeVsG3d4n3vpg6fM0vQXhFFeO/KZLkqc4oUySDBXWx8wrx8KLdGFtbQ6cZUMpsPsAhbqUfLMDRA Zo= X-UI-Out-Filterresults: notjunk:1;V03:K0:/HwWCkfPB+s=:xo1W4tMXzuHJ/1GXZ8FxyF SvzLfDUhi5AqRbM3IPvs+Ko2EdUP/s/Xzr6Rfhjo7rPgfutQTmYwU7El8kV97x5y+tUb4PaB9 XFA64mPFF/aQrEEEsr6Z3cju2ktkMKnqYcl0GcvfdX7tHnHee2eP3W0kQ0gPlFxkpLFUt+TNH defBLdYupffxK2bdsyI5vZ6KQy4NKrIW/DkjhTdOiZ6ErwNZ8Ya9vhdfNs1VmXUcISWyzZauq LgIo+u6LnUPE/BWVUI9GSWjU7/LfnWTtSj3f1O7QvK2V4HEfPltFhGZIMirk84KxEPSpngtou nvZjU3P7CMI7p2JM+qMB/mZ1mERtV8lVVNZonFlA6Leu3qLmnGZ8Hw/WHSL5n8P/elWUl3rXR AYfWWgdoSZY6EAqZgmanrLFSKbLlaiT+WpPNs+Y/SZgHYb/bOJzs0K9BADLnnqBaPfcvdc9y6 vAHuysNc7VWhl7dkf1UTB17T9fwvDr+ide9kjj9UifRxPVbkITHPOKRSi6cnqfDrC7jBj+r3b rsc+wzYHSD16Y5+AuDvu0I1zLq+b4r3qcOXlOf7akyeD0fh4/DuMgviF9NT3HvUVntkEoZwQl ydbUpg6p9ZTIu28sZ/o8732iksea6N9suim9997Syx6/1fF3G7mBUPKCh55H3u2BwjIIP3mc9 PqIsrNgB6OJXE3Wsddhk62BWTxxkK4F5zRWGeMtdD6aEd36f6FDphUv6LgvXMXRRSKm6gkGRS NJYrh0eNsGVj6Dk0bY/rzVNPt7bstn/3MS3l7ocuz4WiiA6NSwJoUyeU/Cmu0cFMcl7BI6Zly sMJM9qjrvco6bgHGKiMw0vD5H7PK2x7QgJ0f9lS2ZI8r/li7e5wp2P/Vx/26NLLRqzLE1OUEs MKBYr0zPvUadjY6w2Hv7LyfTPT/PnwOfih8sHGIItaV4D3GkD20b/FklKHO/4d X-Spam-Status: No, score=-11.2 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, KAM_NUMSUBJECT, KAM_STOCKGEN, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, 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: Harald Anlauf via Gcc-patches From: Harald Anlauf Reply-To: Harald Anlauf Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" Now with the correct patch attached ... Sorry for the confusion! --- Dear Fortranners, we need to check the arguments to the affected GNU intrinsic extensions properly, and - as pointed out in the PR by Tobias - we need to allow function references that have a data pointer result. Also the argument names of the character arguments of the subroutine versions needed a fix ("c" instead of "count"). Regtested on x86_64-pc-linux-gnu. OK for mainline (12)? OK for backports after 11.1 release? Thanks, Harald PR fortran/100154 - ICE in gfc_conv_procedure_call, at fortran/trans-expr.c:6131 Add appropriate static checks for the character and status arguments to the GNU Fortran intrinsic extensions fget[c], fput[c]. Extend variable check to allow a function reference having a data pointer result. gcc/fortran/ChangeLog: PR fortran/100154 * check.c (variable_check): Allow function reference having a data pointer result. (arg_strlen_is_zero): New function. (gfc_check_fgetputc_sub): Add static check of character and status arguments. (gfc_check_fgetput_sub): Likewise. * intrinsic.c (add_subroutines): Fix argument name for the character argument to intrinsic subroutines fget[c], fput[c]. gcc/testsuite/ChangeLog: PR fortran/100154 * gfortran.dg/pr100154.f90: New test. diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 82db8e4e1b2..1d30c93df82 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -1055,6 +1055,13 @@ variable_check (gfc_expr *e, int n, bool allow_proc) return true; } + /* F2018:R902: function reference having a data pointer result. */ + if (e->expr_type == EXPR_FUNCTION + && e->symtree->n.sym->attr.flavor == FL_PROCEDURE + && e->symtree->n.sym->attr.function + && e->symtree->n.sym->attr.pointer) + return true; + gfc_error ("%qs argument of %qs intrinsic at %L must be a variable", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where); @@ -5689,6 +5691,19 @@ gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies) /* Functions for checking FGETC, FPUTC, FGET and FPUT (subroutines and functions). */ +bool +arg_strlen_is_zero (gfc_expr *c, int n) +{ + if (gfc_var_strlen (c) == 0) + { + gfc_error ("%qs argument of %qs intrinsic at %L must have " + "length at least 1", gfc_current_intrinsic_arg[n]->name, + gfc_current_intrinsic, &c->where); + return true; + } + return false; +} + bool gfc_check_fgetputc_sub (gfc_expr *unit, gfc_expr *c, gfc_expr *status) { @@ -5702,13 +5717,19 @@ gfc_check_fgetputc_sub (gfc_expr *unit, gfc_expr *c, gfc_expr *status) return false; if (!kind_value_check (c, 1, gfc_default_character_kind)) return false; + if (strcmp (gfc_current_intrinsic, "fgetc") == 0 + && !variable_check (c, 1, false)) + return false; + if (arg_strlen_is_zero (c, 1)) + return false; if (status == NULL) return true; if (!type_check (status, 2, BT_INTEGER) || !kind_value_check (status, 2, gfc_default_integer_kind) - || !scalar_check (status, 2)) + || !scalar_check (status, 2) + || !variable_check (status, 2, false)) return false; return true; @@ -5729,13 +5750,19 @@ gfc_check_fgetput_sub (gfc_expr *c, gfc_expr *status) return false; if (!kind_value_check (c, 0, gfc_default_character_kind)) return false; + if (strcmp (gfc_current_intrinsic, "fget") == 0 + && !variable_check (c, 0, false)) + return false; + if (arg_strlen_is_zero (c, 0)) + return false; if (status == NULL) return true; if (!type_check (status, 1, BT_INTEGER) || !kind_value_check (status, 1, gfc_default_integer_kind) - || !scalar_check (status, 1)) + || !scalar_check (status, 1) + || !variable_check (status, 1, false)) return false; return true; diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 17fd92eb462..219f04f2317 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -3460,7 +3460,7 @@ add_subroutines (void) /* Argument names. These are used as argument keywords and so need to match the documentation. Please keep this list in sorted order. */ static const char - *a = "a", *c = "count", *cm = "count_max", *com = "command", + *a = "a", *c_ = "c", *c = "count", *cm = "count_max", *com = "command", *cr = "count_rate", *dt = "date", *errmsg = "errmsg", *f = "from", *fp = "frompos", *gt = "get", *h = "harvest", *han = "handler", *length = "length", *ln = "len", *md = "mode", *msk = "mask", @@ -3840,12 +3840,12 @@ add_subroutines (void) add_sym_3s ("fgetc", GFC_ISYM_FGETC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub, ut, BT_INTEGER, di, REQUIRED, INTENT_IN, - c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT, + c_, BT_CHARACTER, dc, REQUIRED, INTENT_OUT, st, BT_INTEGER, di, OPTIONAL, INTENT_OUT); add_sym_2s ("fget", GFC_ISYM_FGET, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub, - c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT, + c_, BT_CHARACTER, dc, REQUIRED, INTENT_OUT, st, BT_INTEGER, di, OPTIONAL, INTENT_OUT); add_sym_1s ("flush", GFC_ISYM_FLUSH, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU, @@ -3855,12 +3855,12 @@ add_subroutines (void) add_sym_3s ("fputc", GFC_ISYM_FPUTC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub, ut, BT_INTEGER, di, REQUIRED, INTENT_IN, - c, BT_CHARACTER, dc, REQUIRED, INTENT_IN, + c_, BT_CHARACTER, dc, REQUIRED, INTENT_IN, st, BT_INTEGER, di, OPTIONAL, INTENT_OUT); add_sym_2s ("fput", GFC_ISYM_FPUT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub, - c, BT_CHARACTER, dc, REQUIRED, INTENT_IN, + c_, BT_CHARACTER, dc, REQUIRED, INTENT_IN, st, BT_INTEGER, di, OPTIONAL, INTENT_OUT); add_sym_1s ("free", GFC_ISYM_FREE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU, diff --git a/gcc/testsuite/gfortran.dg/pr100154.f90 b/gcc/testsuite/gfortran.dg/pr100154.f90 new file mode 100644 index 00000000000..3a1489aaab8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr100154.f90 @@ -0,0 +1,26 @@ +! { dg-do compile } +! { dg-options "-std=gnu" } +! PR100154 - ICE in gfc_conv_procedure_call, at fortran/trans-expr.c:6131 + +program p + implicit none + integer :: n + character, target :: c + character(len=0) :: c0 + character(len=:), allocatable :: cc + n = fget(cc) + n = fget('a') ! { dg-error "must be a variable" } + n = fget(c0) ! { dg-error "must have length at least 1" } + call fget('x') ! { dg-error "must be a variable" } + n = fgetc(5,'a') ! { dg-error "must be a variable" } + call fgetc(5,c0) ! { dg-error "must have length at least 1" } + call fgetc(5,c,1) ! { dg-error "must be a variable" } + call fputc(5,'x',1) ! { dg-error "must be a variable" } + n = fget (ptr_returning_func()) + print *, c +contains + function ptr_returning_func () result (res) + character, pointer :: res + res => c + end +end