https://gcc.gnu.org/g:0ad2c76bea20dbeac753f10df6f9f86d142348d4
commit r15-4171-g0ad2c76bea20dbeac753f10df6f9f86d142348d4
Author: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Tue Oct 1 09:30:59 2024 +0200
Fix parsing of substring refs in coarrays. [PR51815]
The parser was greadily taking the substring ref as an array ref because
an array_spec was present. Fix this by only parsing the coarray (pseudo)
ref when no regular array is present.
gcc/fortran/ChangeLog:
PR fortran/51815
* array.cc (gfc_match_array_ref): Only parse coarray part of
ref.
* match.h (gfc_match_array_ref): Add flag.
* primary.cc (gfc_match_varspec): Request only coarray ref
parsing when no regular array is present. Report error on
unexpected additional ref.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr102532.f90: Fix dg-errors: Add new error.
* gfortran.dg/coarray/substring_1.f90: New test.
Diff:
---
gcc/fortran/array.cc | 9 ++++--
gcc/fortran/match.h | 3 +-
gcc/fortran/primary.cc | 35 ++++++++++++++++-------
gcc/testsuite/gfortran.dg/coarray/substring_1.f90 | 16 +++++++++++
gcc/testsuite/gfortran.dg/pr102532.f90 | 16 +++++++----
5 files changed, 59 insertions(+), 20 deletions(-)
diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index 1fa61ebfe2a0..ed8cb54803b8 100644
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -179,7 +179,7 @@ matched:
match
gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
- int corank)
+ int corank, bool coarray_only)
{
match m;
bool matched_bracket = false;
@@ -198,6 +198,8 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as,
int init,
matched_bracket = true;
goto coarray;
}
+ else if (coarray_only && corank != 0)
+ goto coarray;
if (gfc_match_char ('(') != MATCH_YES)
{
@@ -243,11 +245,12 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec
*as, int init,
coarray:
if (!matched_bracket && gfc_match_char ('[') != MATCH_YES)
{
- if (ar->dimen > 0)
+ int dim = coarray_only ? 0 : ar->dimen;
+ if (dim > 0 || coarray_only)
{
if (corank != 0)
{
- for (int i = ar->dimen; i < GFC_MAX_DIMENSIONS; ++i)
+ for (int i = dim; i < GFC_MAX_DIMENSIONS; ++i)
ar->dimen_type[i] = DIMEN_THIS_IMAGE;
ar->codimen = corank;
}
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 84d84b818259..2c76afb179af 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -317,7 +317,8 @@ match gfc_match_init_expr (gfc_expr **);
/* array.cc. */
match gfc_match_array_spec (gfc_array_spec **, bool, bool);
-match gfc_match_array_ref (gfc_array_ref *, gfc_array_spec *, int, int);
+match gfc_match_array_ref (gfc_array_ref *, gfc_array_spec *, int, int,
+ bool = false);
match gfc_match_array_constructor (gfc_expr **);
/* interface.cc. */
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 09add925fcd1..c11359a559b2 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2192,7 +2192,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag,
bool sub_flag,
bool intrinsic;
bool inferred_type;
locus old_loc;
- char sep;
+ char peeked_char;
tail = NULL;
@@ -2282,9 +2282,10 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag,
bool sub_flag,
sym->ts.u.derived = tgt_expr->ts.u.derived;
}
- if ((inferred_type && !sym->as && gfc_peek_ascii_char () == '(')
- || (equiv_flag && gfc_peek_ascii_char () == '(')
- || gfc_peek_ascii_char () == '[' || sym->attr.codimension
+ peeked_char = gfc_peek_ascii_char ();
+ if ((inferred_type && !sym->as && peeked_char == '(')
+ || (equiv_flag && peeked_char == '(') || peeked_char == '['
+ || sym->attr.codimension
|| (sym->attr.dimension && sym->ts.type != BT_CLASS
&& !sym->attr.proc_pointer && !gfc_is_proc_ptr_comp (primary)
&& !(gfc_matching_procptr_assignment
@@ -2295,6 +2296,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag,
bool sub_flag,
|| CLASS_DATA (sym)->attr.codimension)))
{
gfc_array_spec *as;
+ bool coarray_only = sym->attr.codimension && !sym->attr.dimension
+ && sym->ts.type == BT_CHARACTER;
tail = extend_ref (primary, tail);
tail->type = REF_ARRAY;
@@ -2310,12 +2313,18 @@ 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);
+ m = gfc_match_array_ref (&tail->u.ar, as, equiv_flag, as ? as->corank :
0,
+ coarray_only);
if (m != MATCH_YES)
return m;
gfc_gobble_whitespace ();
+ if (coarray_only)
+ {
+ primary->ts = sym->ts;
+ goto check_substring;
+ }
+
if (equiv_flag && gfc_peek_ascii_char () == '(')
{
tail = extend_ref (primary, tail);
@@ -2333,14 +2342,13 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag,
bool sub_flag,
return MATCH_YES;
/* With DEC extensions, member separator may be '.' or '%'. */
- sep = gfc_peek_ascii_char ();
+ peeked_char = gfc_peek_ascii_char ();
m = gfc_match_member_sep (sym);
if (m == MATCH_ERROR)
return MATCH_ERROR;
inquiry = false;
- if (m == MATCH_YES && sep == '%'
- && primary->ts.type != BT_CLASS
+ if (m == MATCH_YES && peeked_char == '%' && primary->ts.type != BT_CLASS
&& (primary->ts.type != BT_DERIVED || inferred_type))
{
match mm;
@@ -2453,7 +2461,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag,
bool sub_flag,
&& m == MATCH_YES && !inquiry)
{
gfc_error ("Unexpected %<%c%> for nonderived-type variable %qs at %C",
- sep, sym->name);
+ peeked_char, sym->name);
return MATCH_ERROR;
}
@@ -2484,7 +2492,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag,
bool sub_flag,
if (inquiry)
sym = NULL;
- if (sep == '%')
+ if (peeked_char == '%')
{
if (tmp)
{
@@ -2815,6 +2823,11 @@ check_substring:
if (substring)
primary->ts.u.cl = NULL;
+ if (gfc_peek_ascii_char () == '(')
+ {
+ gfc_error_now ("Unexpected array/substring ref at %C");
+ return MATCH_ERROR;
+ }
break;
case MATCH_NO:
diff --git a/gcc/testsuite/gfortran.dg/coarray/substring_1.f90
b/gcc/testsuite/gfortran.dg/coarray/substring_1.f90
new file mode 100644
index 000000000000..3c3ddc7fac42
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/substring_1.f90
@@ -0,0 +1,16 @@
+!{ dg-do run }
+
+! Test PR51815 is fixed
+! Contributed by Bill Long <longb ad cray dot com>
+
+PROGRAM pr51815
+ implicit none
+ character(10) :: s[*]
+ character(18) :: d = 'ABCDEFGHIJKLMNOPQR'
+ integer :: img
+
+ img = this_image()
+ s = d(img:img+9)
+ if (img == 1 .and. s(2:4) /= 'BCD') stop 1
+END PROGRAM
+
diff --git a/gcc/testsuite/gfortran.dg/pr102532.f90
b/gcc/testsuite/gfortran.dg/pr102532.f90
index 714379a6ac27..cc6e2e9215a8 100644
--- a/gcc/testsuite/gfortran.dg/pr102532.f90
+++ b/gcc/testsuite/gfortran.dg/pr102532.f90
@@ -5,12 +5,18 @@
!
subroutine foo
character(:), allocatable :: x[:]
- associate (y => x(:)(2:)) ! { dg-error "Rank mismatch|deferred type
parameter" }
- end associate
+ character(:), dimension(:), allocatable :: c[:]
+ associate (y => x(:)(2:)) ! { dg-error "Unexpected array/substring
ref|Invalid association target" }
+ end associate ! { dg-error "Expecting END SUBROUTINE" }
+ associate (a => c(:)(:)(2:)) ! { dg-error "Unexpected array/substring
ref|Invalid association target" }
+ end associate ! { dg-error "Expecting END SUBROUTINE" }
end
subroutine bar
character(:), allocatable :: x[:]
- associate (y => x(:)(:)) ! { dg-error "Rank mismatch|deferred type
parameter" }
- end associate
-end
\ No newline at end of file
+ character(:), allocatable :: c
+
+ associate (y => x(:)(:)) ! { dg-error "Unexpected array/substring
ref|Invalid association target" }
+ end associate ! { dg-error "Expecting END SUBROUTINE" }
+ c = x(:)(2:5) ! { dg-error "Unexpected array/substring ref" }
+end
