Hi Harald, thank you for your input. I still have some small nits to discuss to make everyone happy. Therefore:
> this seems to go into the right direction - except that I am not a > great fan of gfc_error_now, as that tries to paper over deficiencies > in error recovery. Me either, but when I remove the gfc_error_now() and only do > if (gfc_peek_ascii_char () == '(') > return MATCH_ERROR; as you proposed, then no error is given for: character(:), allocatable :: x[:] character(:), allocatable :: c c = x(:)(2:5) I.e. nothing at all. Therefore at the moment I prefer to stick to the initial solution with the gfc_error_now, which not only gives an error in the associate, but also when one just does an array/substring-ref outside of parentheses. And I like the new error message, because I consider it more helpful than just a syntax error or the invalid association target message. What do you think? > Is there a reason that you do not check the return value of > gfc_match_array_ref? What am I to do with the result? We are in an error case independent of the result of gfc_match_array_ref. The intention of using that routine here was to digest the unexpected input and allow for (easier|better) error recovery. May be I should just put a comment on it, to make it more clear. Or is there another way to help the parser recover from an error? Sorry for the additional round. But this error has been around for so long, that it doesn't matter, if we need another day to come up with a solution. Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline? Regards, Andre > Indeed your suggestion (or the shortened version above) improves > the diagnostics ("user experience") also for this variant: > > subroutine foo > character(:), allocatable :: x[:] > character(:), dimension(:), allocatable :: c[:] > type t > character(:), allocatable :: x[:] > character(:), dimension(:), allocatable :: c[:] > end type t > type(t) :: z > associate (y => x(:)(2:)) > end associate > associate (a => c(:)(:)(2:)) > end associate > associate (y => z%x(:)(2:)) > end associate > associate (a => z%c(:)(:)(2:)) > end associate > end > > with several error messages of the kind > > Error: Invalid association target at (1) > > or > > Error: Rank mismatch in array reference at (1) (1/0) > > looking less technical than a parsing error. > I think this is as good as it can be. > > So OK from my side with either your additional patch or my > shortened version. > > Thanks for the patch! > > Harald > > > > Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Is this ok? > > > > Regards and thanks for the review, > > Andre > > > > On Tue, 1 Oct 2024 23:31:11 +0200 > > Harald Anlauf <anl...@gmx.de> wrote: > > > >> Hi Andre, > >> > >> Am 01.10.24 um 09:43 schrieb Andre Vehreschild: > >>> 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). > >> > >> while the patch addresses the issue mentioned in the PR, > >> > >>> 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. > >> > >> I find the error messages now less helpful to users: before the patch > >> we got "Rank mismatch in array reference", which was more suitable > >> than the newer version with more or less confusing syntax errors. > >> > >> I assume you tried to find a better solution - but Intel and NAG > >> also give syntax errors - so basically I am fine with the patch. > >> > >> You may want to wait for a second opinion. If nobody else responds > >> within the next 2 days, you may proceed nevertheless. > >> > >> Thanks, > >> Harald > >> > >>> Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline? > >>> > >>> Regards, > >>> Andre > >>> -- > >>> Andre Vehreschild * Email: vehre ad gmx dot de > >> > > > > > > -- > > Andre Vehreschild * Email: vehre ad gmx dot de > > > -- Andre Vehreschild * Email: vehre ad gmx dot de
From bf33a961a501e7a31f510518830e420a3f1e3b78 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] 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. --- gcc/fortran/array.cc | 9 ++-- gcc/fortran/match.h | 3 +- gcc/fortran/primary.cc | 41 ++++++++++++++----- .../gfortran.dg/coarray/substring_1.f90 | 16 ++++++++ gcc/testsuite/gfortran.dg/pr102532.f90 | 16 +++++--- 5 files changed, 65 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..e34c0074580 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,17 @@ check_substring: if (substring) primary->ts.u.cl = NULL; + if (gfc_peek_ascii_char () == '(') + { + gfc_array_ref arr_ref; + gfc_array_spec *as + = sym->ts.type == BT_CLASS ? CLASS_DATA (sym)->as : sym->as; + /* Digest the unexpected array ref to easen error recovery. */ + gfc_match_array_ref (&arr_ref, as, 0, 0); + + 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 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..cc6e2e9215a 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 -- 2.46.2