From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2071) id C7F3F3858D28; Sun, 5 Mar 2023 19:36:43 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org C7F3F3858D28 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1678045003; bh=y6kAmNednp2oAy9N+B9/uv48stu9nQFE8akbL6QRNq8=; h=From:To:Subject:Date:From; b=YOmB1rNBk9kc2BwDz9TLawf0NGVRU0k416YvQEs1uTbm5zoRpnDCWAz8Da27iUca6 hzXqLAJ1dRKhuUSOH28akUEmX1tN0SS8zyXLwEscxMf0d3pa9UU+/4NV4bSc+DMT/F eXYApdwpgLBoVSaA36AQt9aQQzIGWPcXbDts0ZZc= MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Harald Anlauf To: gcc-cvs@gcc.gnu.org Subject: [gcc r10-11239] Fortran: improve checking of character length specification [PR96025] X-Act-Checkin: gcc X-Git-Author: Harald Anlauf X-Git-Refname: refs/heads/releases/gcc-10 X-Git-Oldrev: aaf5fba354ea5d84f6471ad79f0c066e1204c80d X-Git-Newrev: 9db1287c8ced5425f6ef9d26b05a3eb9cbcc4b8d Message-Id: <20230305193643.C7F3F3858D28@sourceware.org> Date: Sun, 5 Mar 2023 19:36:43 +0000 (GMT) List-Id: https://gcc.gnu.org/g:9db1287c8ced5425f6ef9d26b05a3eb9cbcc4b8d commit r10-11239-g9db1287c8ced5425f6ef9d26b05a3eb9cbcc4b8d Author: Harald Anlauf Date: Mon Feb 20 21:28:09 2023 +0100 Fortran: improve checking of character length specification [PR96025] gcc/fortran/ChangeLog: PR fortran/96025 * parse.c (check_function_result_typed): Improve type check of specification expression for character length and return status. (parse_spec): Use status from above. * resolve.c (resolve_fntype): Prevent use of invalid specification expression for character length. gcc/testsuite/ChangeLog: PR fortran/96025 * gfortran.dg/pr96025.f90: New test. (cherry picked from commit 6c1b825b3d6499dfeacf7c79dcf4b56a393ac204) Diff: --- gcc/fortran/parse.c | 25 ++++++++++++++----------- gcc/fortran/resolve.c | 4 +++- gcc/testsuite/gfortran.dg/pr96025.f90 | 11 +++++++++++ 3 files changed, 28 insertions(+), 12 deletions(-) diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 6ddc5171e2f..69c0f4350ad 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -3702,21 +3702,30 @@ match_deferred_characteristics (gfc_typespec * ts) For return types specified in a FUNCTION prefix, the IMPLICIT rules of the scope are not yet parsed so this has to be delayed up to parse_spec. */ -static void +static bool check_function_result_typed (void) { gfc_typespec ts; gcc_assert (gfc_current_state () == COMP_FUNCTION); - if (!gfc_current_ns->proc_name->result) return; + if (!gfc_current_ns->proc_name->result) + return true; ts = gfc_current_ns->proc_name->result->ts; /* Check type-parameters, at the moment only CHARACTER lengths possible. */ /* TODO: Extend when KIND type parameters are implemented. */ if (ts.type == BT_CHARACTER && ts.u.cl && ts.u.cl->length) - gfc_expr_check_typed (ts.u.cl->length, gfc_current_ns, true); + { + /* Reject invalid type of specification expression for length. */ + if (ts.u.cl->length->ts.type != BT_INTEGER) + return false; + + gfc_expr_check_typed (ts.u.cl->length, gfc_current_ns, true); + } + + return true; } @@ -3824,10 +3833,7 @@ loop: } if (verify_now) - { - check_function_result_typed (); - function_result_typed = true; - } + function_result_typed = check_function_result_typed (); } switch (st) @@ -3838,10 +3844,7 @@ loop: case ST_IMPLICIT_NONE: case ST_IMPLICIT: if (!function_result_typed) - { - check_function_result_typed (); - function_result_typed = true; - } + function_result_typed = check_function_result_typed (); goto declSt; case ST_FORMAT: diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 70c6f57279a..3163f63c996 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -17139,7 +17139,9 @@ resolve_fntype (gfc_namespace *ns) } } - if (sym->ts.type == BT_CHARACTER) + if (sym->ts.type == BT_CHARACTER + && sym->ts.u.cl->length + && sym->ts.u.cl->length->ts.type == BT_INTEGER) gfc_traverse_expr (sym->ts.u.cl->length, sym, flag_fn_result_spec, 0); } diff --git a/gcc/testsuite/gfortran.dg/pr96025.f90 b/gcc/testsuite/gfortran.dg/pr96025.f90 new file mode 100644 index 00000000000..ce292bd9664 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr96025.f90 @@ -0,0 +1,11 @@ +! { dg-do compile } +! PR fortran/96025 - ICE in expr_check_typed_help +! Contributed by G.Steinmetz + +program p + print *, f() +contains + character(char(1)) function f() ! { dg-error "must be of INTEGER type" } + f = 'f' + end +end