aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/simplify.c
diff options
context:
space:
mode:
authorHarald Anlauf <anlauf@gmx.de>2021-08-19 21:00:45 +0200
committerHarald Anlauf <anlauf@gmx.de>2021-08-19 21:00:45 +0200
commitd881460deb1f0bdfc3e8fa2d391a03a9763cbff4 (patch)
tree99d7aa1b245947c4775682b02b4b5a598a7b983e /gcc/fortran/simplify.c
parent77bf9f83b8e388de8bedb259991f588a7b8a7f57 (diff)
downloadgcc-d881460deb1f0bdfc3e8fa2d391a03a9763cbff4.zip
gcc-d881460deb1f0bdfc3e8fa2d391a03a9763cbff4.tar.gz
gcc-d881460deb1f0bdfc3e8fa2d391a03a9763cbff4.tar.bz2
Fortran - simplify length of substring with constant bounds
gcc/fortran/ChangeLog: PR fortran/100950 * simplify.c (substring_has_constant_len): New. (gfc_simplify_len): Handle case of substrings with constant bounds. gcc/testsuite/ChangeLog: PR fortran/100950 * gfortran.dg/pr100950.f90: New test.
Diffstat (limited to 'gcc/fortran/simplify.c')
-rw-r--r--gcc/fortran/simplify.c75
1 files changed, 74 insertions, 1 deletions
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index c27b47a..492867e 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4512,6 +4512,78 @@ gfc_simplify_leadz (gfc_expr *e)
}
+/* Check for constant length of a substring. */
+
+static bool
+substring_has_constant_len (gfc_expr *e)
+{
+ gfc_ref *ref;
+ HOST_WIDE_INT istart, iend, length;
+ bool equal_length = false;
+
+ if (e->ts.type != BT_CHARACTER)
+ return false;
+
+ for (ref = e->ref; ref; ref = ref->next)
+ if (ref->type != REF_COMPONENT && ref->type != REF_ARRAY)
+ break;
+
+ if (!ref
+ || ref->type != REF_SUBSTRING
+ || !ref->u.ss.start
+ || ref->u.ss.start->expr_type != EXPR_CONSTANT
+ || !ref->u.ss.end
+ || ref->u.ss.end->expr_type != EXPR_CONSTANT
+ || !ref->u.ss.length)
+ return false;
+
+ /* For non-deferred strings the given length shall be constant. */
+ if (!e->ts.deferred
+ && (!ref->u.ss.length->length
+ || ref->u.ss.length->length->expr_type != EXPR_CONSTANT))
+ return false;
+
+ /* Basic checks on substring starting and ending indices. */
+ if (!gfc_resolve_substring (ref, &equal_length))
+ return false;
+
+ istart = gfc_mpz_get_hwi (ref->u.ss.start->value.integer);
+ iend = gfc_mpz_get_hwi (ref->u.ss.end->value.integer);
+
+ if (istart <= iend)
+ {
+ if (istart < 1)
+ {
+ gfc_error ("Substring start index (" HOST_WIDE_INT_PRINT_DEC
+ ") at %L below 1",
+ istart, &ref->u.ss.start->where);
+ return false;
+ }
+
+ /* For deferred strings use end index as proxy for length. */
+ if (e->ts.deferred)
+ length = iend;
+ else
+ length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
+ if (iend > length)
+ {
+ gfc_error ("Substring end index (" HOST_WIDE_INT_PRINT_DEC
+ ") at %L exceeds string length",
+ iend, &ref->u.ss.end->where);
+ return false;
+ }
+ length = iend - istart + 1;
+ }
+ else
+ length = 0;
+
+ /* Fix substring length. */
+ e->value.character.length = length;
+
+ return true;
+}
+
+
gfc_expr *
gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
{
@@ -4521,7 +4593,8 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
if (k == -1)
return &gfc_bad_expr;
- if (e->expr_type == EXPR_CONSTANT)
+ if (e->expr_type == EXPR_CONSTANT
+ || substring_has_constant_len (e))
{
result = gfc_get_constant_expr (BT_INTEGER, k, &e->where);
mpz_set_si (result->value.integer, e->value.character.length);