Dear all,
the attached patch fixes a variety of small issues with parsing of
inquiry references of substrings. The testcase exercises variations
of the examples in the PR and ensures that these are successfully
simplified.
Don't try it with other compilers... ;-)
Regtested on x86_64-pc-linux-gnu. OK for mainline?
I believe this is sufficiently safe that it can be backported
later to 15-branch, unless someone objects.
Thanks,
Harald
From 48a3bb2f5822b0e69211e89bd92fa3d497321f4c Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Tue, 27 May 2025 19:23:16 +0200
Subject: [PATCH] Fortran: fix parsing of type parameter inquiries of
substrings [PR101735]
Handling of type parameter inquiries of substrings failed to due either
parsing issues or not following or handling reference chains properly.
PR fortran/101735
gcc/fortran/ChangeLog:
* expr.cc (find_inquiry_ref): If an inquiry reference applies to
a substring, use that, and calculate substring length if needed.
* primary.cc (extend_ref): Also handle attaching to end of
reference chain for appending.
(gfc_match_varspec): Discrimate between arrays of character and
substrings of them. If a substring is taken from a character
component of a derived type, get the proper typespec so that
inquiry references work correctly.
(gfc_match_rvalue): Handle corner case where we hit a seemingly
dangling '%' and missed an inquiry reference. Try another match.
gcc/testsuite/ChangeLog:
* gfortran.dg/inquiry_type_ref_7.f90: New test.
---
gcc/fortran/expr.cc | 26 ++++++++
gcc/fortran/primary.cc | 60 ++++++++++++++++--
.../gfortran.dg/inquiry_type_ref_7.f90 | 62 +++++++++++++++++++
3 files changed, 142 insertions(+), 6 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 92a9ebdcbe8..bf858ea5791 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -1846,6 +1846,7 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
gfc_ref *ref;
gfc_ref *inquiry = NULL;
gfc_ref *inquiry_head;
+ gfc_ref *ref_ss = NULL;
gfc_expr *tmp;
tmp = gfc_copy_expr (p);
@@ -1862,6 +1863,9 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
{
inquiry = ref->next;
ref->next = NULL;
+ if (ref->type == REF_SUBSTRING)
+ ref_ss = ref;
+ break;
}
}
@@ -1891,6 +1895,28 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
if (!gfc_notify_std (GFC_STD_F2003, "LEN part_ref at %C"))
goto cleanup;
+ /* Inquire length of substring? */
+ if (ref_ss)
+ {
+ if (ref_ss->u.ss.start->expr_type == EXPR_CONSTANT
+ && ref_ss->u.ss.end->expr_type == EXPR_CONSTANT)
+ {
+ HOST_WIDE_INT istart, iend, length;
+ istart = gfc_mpz_get_hwi (ref_ss->u.ss.start->value.integer);
+ iend = gfc_mpz_get_hwi (ref_ss->u.ss.end->value.integer);
+
+ if (istart <= iend)
+ length = iend - istart + 1;
+ else
+ length = 0;
+ *newp = gfc_get_int_expr (gfc_default_integer_kind,
+ NULL, length);
+ break;
+ }
+ else
+ goto cleanup;
+ }
+
if (tmp->ts.u.cl->length
&& tmp->ts.u.cl->length->expr_type == EXPR_CONSTANT)
*newp = gfc_copy_expr (tmp->ts.u.cl->length);
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index ec4e13548c4..426c994e67d 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2102,10 +2102,18 @@ extend_ref (gfc_expr *primary, gfc_ref *tail)
{
if (primary->ref == NULL)
primary->ref = tail = gfc_get_ref ();
+ else if (tail == NULL)
+ {
+ /* Set tail to end of reference chain. */
+ for (gfc_ref *ref = primary->ref; ref; ref = ref->next)
+ if (ref->next == NULL)
+ {
+ tail = ref;
+ break;
+ }
+ }
else
{
- if (tail == NULL)
- gfc_internal_error ("extend_ref(): Bad tail");
tail->next = gfc_get_ref ();
tail = tail->next;
}
@@ -2302,9 +2310,22 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
gfc_array_spec *as;
bool coarray_only = sym->attr.codimension && !sym->attr.dimension
&& sym->ts.type == BT_CHARACTER;
+ gfc_ref *ref, *strarr = NULL;
tail = extend_ref (primary, tail);
- tail->type = REF_ARRAY;
+ if (sym->ts.type == BT_CHARACTER && tail->type == REF_SUBSTRING)
+ {
+ gcc_assert (sym->attr.dimension);
+ /* Find array reference for substrings of character arrays. */
+ for (ref = primary->ref; ref && ref->next; ref = ref->next)
+ if (ref->type == REF_ARRAY && ref->next->type == REF_SUBSTRING)
+ {
+ strarr = ref;
+ break;
+ }
+ }
+ else
+ tail->type = REF_ARRAY;
/* In EQUIVALENCE, we don't know yet whether we are seeing
an array, character variable or array of character
@@ -2317,7 +2338,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
else
as = sym->as;
- m = gfc_match_array_ref (&tail->u.ar, as, equiv_flag, as ? as->corank : 0,
+ ref = strarr ? strarr : tail;
+ m = gfc_match_array_ref (&ref->u.ar, as, equiv_flag, as ? as->corank : 0,
coarray_only);
if (m != MATCH_YES)
return m;
@@ -2483,6 +2505,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
{
bool t;
gfc_symtree *tbp;
+ gfc_typespec *ts = &primary->ts;
m = gfc_match_name (name);
if (m == MATCH_NO)
@@ -2490,8 +2513,18 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
if (m != MATCH_YES)
return MATCH_ERROR;
+ /* For derived type components find typespec of ultimate component. */
+ if (ts->type == BT_DERIVED && primary->ref)
+ {
+ for (gfc_ref *ref = primary->ref; ref; ref = ref->next)
+ {
+ if (ref->type == REF_COMPONENT && ref->u.c.component)
+ ts = &ref->u.c.component->ts;
+ }
+ }
+
intrinsic = false;
- if (primary->ts.type != BT_CLASS && primary->ts.type != BT_DERIVED)
+ if (ts->type != BT_CLASS && ts->type != BT_DERIVED)
{
inquiry = is_inquiry_ref (name, &tmp);
if (inquiry)
@@ -2564,7 +2597,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
return MATCH_ERROR;
}
else if (tmp->u.i == INQUIRY_LEN
- && primary->ts.type != BT_CHARACTER)
+ && ts->type != BT_CHARACTER)
{
gfc_error ("The LEN part_ref at %C must be applied "
"to a CHARACTER expression");
@@ -2653,6 +2686,10 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
else if (component == NULL && !inquiry)
return MATCH_ERROR;
+ /* Find end of reference chain if inquiry reference and tail not set. */
+ if (tail == NULL && inquiry && tmp)
+ tail = extend_ref (primary, tail);
+
/* Extend the reference chain determined by gfc_find_component or
is_inquiry_ref. */
if (primary->ref == NULL)
@@ -2828,6 +2865,7 @@ check_substring:
if (substring)
primary->ts.u.cl = NULL;
+ gfc_gobble_whitespace ();
if (gfc_peek_ascii_char () == '(')
{
gfc_error_now ("Unexpected array/substring ref at %C");
@@ -4271,6 +4309,16 @@ gfc_match_rvalue (gfc_expr **result)
return MATCH_ERROR;
}
+ /* Scan for possible inquiry references. */
+ if (m == MATCH_YES
+ && e->expr_type == EXPR_VARIABLE
+ && gfc_peek_ascii_char () == '%')
+ {
+ m = gfc_match_varspec (e, 0, false, false);
+ if (m == MATCH_NO)
+ m = MATCH_YES;
+ }
+
if (m == MATCH_YES)
{
e->where = where;
diff --git a/gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90 b/gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90
new file mode 100644
index 00000000000..534225a742d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90
@@ -0,0 +1,62 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/101735 - substrings and parsing of type parameter inquiries
+
+program p
+ implicit none
+ integer, parameter :: ck = 4
+ character(len=5) :: str = ""
+ character(len=5) :: str2(4)
+ character(len=5,kind=ck) :: str4 = ck_""
+ type t
+ character(len=5) :: str(4)
+ end type t
+ type(t) :: var
+ integer :: x, y
+
+ integer, parameter :: i1 = kind (str(1:3))
+ integer, parameter :: j1 = str (1:3) % kind
+ integer, parameter :: k1 = (str(1:3) % kind)
+ integer, parameter :: kk = str (1:3) % kind % kind
+
+ integer, parameter :: i4 = kind (str4(1:3))
+ integer, parameter :: j4 = str4 (1:3) % kind
+ integer, parameter :: ll = str4 (1:3) % len
+
+ integer, parameter :: i2 = len (str(1:3))
+ integer, parameter :: j2 = str (1:3) % len
+ integer, parameter :: k2 = (str(1:3) % len)
+ integer, parameter :: lk = str (1:3) % len % kind
+
+ integer, parameter :: l4 = str2 (:) (2:3) % len
+ integer, parameter :: l5 = var % str (:) (2:4) % len
+ integer, parameter :: k4 = str2 (:) (2:3) % kind
+ integer, parameter :: k5 = var % str (:) (2:4) % kind
+ integer, parameter :: k6 = str2 (:) (2:3) % len % kind
+ integer, parameter :: k7 = var % str (:) (2:4) % len % kind
+
+ if (i1 /= 1) stop 1
+ if (j1 /= 1) stop 2
+ if (k1 /= 1) stop 3
+
+ if (i4 /= ck) stop 4
+ if (j4 /= ck) stop 5
+ if (ll /= 3) stop 6
+
+ if (kk /= 4) stop 7
+ if (lk /= 4) stop 8
+
+ if (i2 /= 3) stop 9
+ if (j2 /= 3) stop 10
+ if (k2 /= 3) stop 11
+
+ if (l4 /= 2) stop 12
+ if (l5 /= 3) stop 13
+ if (k4 /= 1) stop 14
+ if (k5 /= 1) stop 15
+ if (k6 /= 4) stop 16
+ if (k7 /= 4) stop 17
+end
+
+! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "original" } }
--
2.43.0
