Hi all,
this rather old PR reported a parsing bug, when a coarray'ed character substring
ref is to be parsed, aka CHARACTER(:) :: str[:] ... str(2:5). In this case the
parser confused the substring ref with an array-ref, because an array_spec was
present. This patch fixes this by requesting only coarray parsing from
gfc_match_array_ref when no regular dimension is present. The patch is not
involved when an array of coarray'ed strings is parsed (that worked
beforehand).
I had to fix the dg-error clauses in the testcase pr102532 because now the error
of having to many refs is detected by the parsing stage and no longer by the
resolve stage. It has become a simple syntax error. I hope this is ok.
Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From 1d5e0abd0e6df0ec05c3dfb4bf7cee433b885994 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Tue, 1 Oct 2024 09:30:59 +0200
Subject: [PATCH] [Fortran] 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.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr102532.f90: Fix dg-errors: Now a syntax error.
* gfortran.dg/coarray/substring_1.f90: New test.
---
gcc/fortran/array.cc | 9 ++++--
gcc/fortran/match.h | 3 +-
gcc/fortran/primary.cc | 30 ++++++++++++-------
.../gfortran.dg/coarray/substring_1.f90 | 16 ++++++++++
gcc/testsuite/gfortran.dg/pr102532.f90 | 13 ++++----
5 files changed, 51 insertions(+), 20 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/substring_1.f90
diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index 1fa61ebfe2a..ed8cb54803b 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 84d84b81825..2c76afb179a 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 09add925fcd..d73d5eaed84 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)
{
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 00000000000..3c3ddc7fac4
--- /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 714379a6ac2..999ca88482f 100644
--- a/gcc/testsuite/gfortran.dg/pr102532.f90
+++ b/gcc/testsuite/gfortran.dg/pr102532.f90
@@ -5,12 +5,15 @@
!
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 "Expected '\\)' or ','" }
+ end associate ! { dg-error "Expecting END SUBROUTINE" }
+ associate (a => c(:)(:)(2:)) ! { dg-error "Expected '\\)' or ','" }
+ 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
+ associate (y => x(:)(:)) ! { dg-error "Expected '\\)' or ','" }
+ end associate ! { dg-error "Expecting END SUBROUTINE" }
+end
--
2.46.2
