diff options
| -rw-r--r-- | gcc/fortran/gfortran.h | 1 | ||||
| -rw-r--r-- | gcc/fortran/primary.c | 55 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 6 | ||||
| -rw-r--r-- | gcc/testsuite/substr_10.f90 | 11 | ||||
| -rw-r--r-- | gcc/testsuite/substr_9.f90 | 28 |
5 files changed, 98 insertions, 3 deletions
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 6585e4f..4dd72b6 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3467,6 +3467,7 @@ bool find_forall_index (gfc_expr *, gfc_symbol *, int); bool gfc_resolve_index (gfc_expr *, int); bool gfc_resolve_dim_arg (gfc_expr *); bool gfc_is_formal_arg (void); +bool gfc_resolve_substring (gfc_ref *, bool *); void gfc_resolve_substring_charlen (gfc_expr *); match gfc_iso_c_sub_interface(gfc_code *, gfc_symbol *); gfc_expr *gfc_expr_to_initialize (gfc_expr *); 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; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index ab7ffc2..bb069ef 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5068,8 +5068,8 @@ resolve_array_ref (gfc_array_ref *ar) } -static bool -resolve_substring (gfc_ref *ref, bool *equal_length) +bool +gfc_resolve_substring (gfc_ref *ref, bool *equal_length) { int k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false); @@ -5277,7 +5277,7 @@ gfc_resolve_ref (gfc_expr *expr) case REF_SUBSTRING: equal_length = false; - if (!resolve_substring (*prev, &equal_length)) + if (!gfc_resolve_substring (*prev, &equal_length)) return false; if (expr->expr_type != EXPR_SUBSTRING && equal_length) diff --git a/gcc/testsuite/substr_10.f90 b/gcc/testsuite/substr_10.f90 new file mode 100644 index 0000000..918ca8a --- /dev/null +++ b/gcc/testsuite/substr_10.f90 @@ -0,0 +1,11 @@ +! { dg-do compile } +! PR93340 - test error handling of substring simplification + +subroutine p + integer,parameter :: k = len ('a'(:0)) + integer,parameter :: m = len ('a'(0:)) ! { dg-error "Substring start index" } + call foo ('bcd'(-8:-9)) + call foo ('bcd'(-9:-8)) ! { dg-error "Substring start index" } + call foo ('bcd'(:12)) ! { dg-error "Substring end index" } + call foo ('bcd'(-12:)) ! { dg-error "Substring start index" } +end diff --git a/gcc/testsuite/substr_9.f90 b/gcc/testsuite/substr_9.f90 new file mode 100644 index 0000000..73152d6 --- /dev/null +++ b/gcc/testsuite/substr_9.f90 @@ -0,0 +1,28 @@ +! { dg-do run } +! { dg-options "-std=gnu -fdump-tree-original" } +! PR93340 - issues with substrings in initializers + +program p + implicit none + integer, parameter :: m = 1 + character b(2) /'a', 'b' (1:1)/ + character c(2) /'a', 'bc' (1:1)/ + character d(2) /'a', 'bxyz'(m:m)/ + character e(2) + character f(2) + data e /'a', 'bxyz'( :1)/ + data f /'a', 'xyzb'(4:4)/ + character :: g(2) = [ 'a', 'b' (1:1) ] + character :: h(2) = [ 'a', 'bc'(1:1) ] + character :: k(2) = [ 'a', 'bc'(m:1) ] + if (b(2) /= "b") stop 1 + if (c(2) /= "b") stop 2 + if (d(2) /= "b") stop 3 + if (e(2) /= "b") stop 4 + if (f(2) /= "b") stop 5 + if (g(2) /= "b") stop 6 + if (h(2) /= "b") stop 7 + if (k(2) /= "b") stop 8 +end + +! { dg-final { scan-tree-dump-times "xyz" 0 "original" } } |