aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/primary.c
diff options
context:
space:
mode:
authorHarald Anlauf <anlauf@gmx.de>2021-01-14 20:25:33 +0100
committerHarald Anlauf <anlauf@gmx.de>2021-01-14 20:25:33 +0100
commitbdd1b1f55529da00b867ef05a53a08fbfc3d1c2e (patch)
treef17fdbfa2b6eee1ecd66faa80e0292f69fef5c2c /gcc/fortran/primary.c
parent3651c1b5c9c0960e50f00ca5b59d144b8a586b5d (diff)
downloadgcc-bdd1b1f55529da00b867ef05a53a08fbfc3d1c2e.zip
gcc-bdd1b1f55529da00b867ef05a53a08fbfc3d1c2e.tar.gz
gcc-bdd1b1f55529da00b867ef05a53a08fbfc3d1c2e.tar.bz2
PR fortran/93340 - fix missed substring simplifications
Substrings were not reduced early enough for use in initializations, such as DATA statements. Add an early simplification for substrings with constant starting and ending points. gcc/fortran/ChangeLog: * gfortran.h (gfc_resolve_substring): Add prototype. * primary.c (match_string_constant): Simplify substrings with constant starting and ending points. * resolve.c: Rename resolve_substring to gfc_resolve_substring. (gfc_resolve_ref): Use renamed function gfc_resolve_substring. gcc/testsuite/ChangeLog: * substr_10.f90: New test. * substr_9.f90: New test.
Diffstat (limited to 'gcc/fortran/primary.c')
-rw-r--r--gcc/fortran/primary.c55
1 files changed, 55 insertions, 0 deletions
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index db9ecf9..d0610d0 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1190,6 +1190,61 @@ got_delim:
if (match_substring (NULL, 0, &e->ref, false) != MATCH_NO)
e->expr_type = EXPR_SUBSTRING;
+ /* Substrings with constant starting and ending points are eligible as
+ designators (F2018, section 9.1). Simplify substrings to make them usable
+ e.g. in data statements. */
+ if (e->expr_type == EXPR_SUBSTRING
+ && e->ref && e->ref->type == REF_SUBSTRING
+ && e->ref->u.ss.start->expr_type == EXPR_CONSTANT
+ && (e->ref->u.ss.end == NULL
+ || e->ref->u.ss.end->expr_type == EXPR_CONSTANT))
+ {
+ gfc_expr *res;
+ ptrdiff_t istart, iend;
+ size_t length;
+ bool equal_length = false;
+
+ /* Basic checks on substring starting and ending indices. */
+ if (!gfc_resolve_substring (e->ref, &equal_length))
+ return MATCH_ERROR;
+
+ length = e->value.character.length;
+ istart = gfc_mpz_get_hwi (e->ref->u.ss.start->value.integer);
+ if (e->ref->u.ss.end == NULL)
+ iend = length;
+ else
+ iend = gfc_mpz_get_hwi (e->ref->u.ss.end->value.integer);
+
+ if (istart <= iend)
+ {
+ if (istart < 1)
+ {
+ gfc_error ("Substring start index (%ld) at %L below 1",
+ (long) istart, &e->ref->u.ss.start->where);
+ return MATCH_ERROR;
+ }
+ if (iend > (ssize_t) length)
+ {
+ gfc_error ("Substring end index (%ld) at %L exceeds string "
+ "length", (long) iend, &e->ref->u.ss.end->where);
+ return MATCH_ERROR;
+ }
+ length = iend - istart + 1;
+ }
+ else
+ length = 0;
+
+ res = gfc_get_constant_expr (BT_CHARACTER, e->ts.kind, &e->where);
+ res->value.character.string = gfc_get_wide_string (length + 1);
+ res->value.character.length = length;
+ if (length > 0)
+ memcpy (res->value.character.string,
+ &e->value.character.string[istart - 1],
+ length * sizeof (gfc_char_t));
+ res->value.character.string[length] = '\0';
+ e = res;
+ }
+
*result = e;
return MATCH_YES;