public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: Harald Anlauf <anlauf@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc r14-1505] Fortran: fix diagnostics for SELECT RANK [PR100607] Date: Fri, 2 Jun 2023 17:59:16 +0000 (GMT) [thread overview] Message-ID: <20230602175916.BB02B3858D3C@sourceware.org> (raw) https://gcc.gnu.org/g:fae09dfc0e6bf4cfe35d817558827aea78c6426f commit r14-1505-gfae09dfc0e6bf4cfe35d817558827aea78c6426f Author: Steve Kargl <kargl@gcc.gnu.org> Date: Fri Jun 2 19:44:11 2023 +0200 Fortran: fix diagnostics for SELECT RANK [PR100607] gcc/fortran/ChangeLog: PR fortran/100607 * resolve.cc (resolve_select_rank): Remove duplicate error. (resolve_fl_var_and_proc): Prevent NULL pointer dereference and suppress error message for temporary. gcc/testsuite/ChangeLog: PR fortran/100607 * gfortran.dg/select_rank_6.f90: New test. Diff: --- gcc/fortran/resolve.cc | 10 +++--- gcc/testsuite/gfortran.dg/select_rank_6.f90 | 48 +++++++++++++++++++++++++++++ 2 files changed, 52 insertions(+), 6 deletions(-) diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 2ba3101f1fe..fd059dddf05 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -10020,11 +10020,6 @@ resolve_select_rank (gfc_code *code, gfc_namespace *old_ns) || gfc_expr_attr (code->expr1).pointer)) gfc_error ("RANK (*) at %L cannot be used with the pointer or " "allocatable selector at %L", &c->where, &code->expr1->where); - - if (case_value == -1 && (gfc_expr_attr (code->expr1).allocatable - || gfc_expr_attr (code->expr1).pointer)) - gfc_error ("RANK (*) at %L cannot be used with the pointer or " - "allocatable selector at %L", &c->where, &code->expr1->where); } /* Add EXEC_SELECT to switch on rank. */ @@ -13262,7 +13257,10 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag) if (allocatable) { - if (dimension && as->type != AS_ASSUMED_RANK) + if (dimension + && as + && as->type != AS_ASSUMED_RANK + && !sym->attr.select_rank_temporary) { gfc_error ("Allocatable array %qs at %L must have a deferred " "shape or assumed rank", sym->name, &sym->declared_at); diff --git a/gcc/testsuite/gfortran.dg/select_rank_6.f90 b/gcc/testsuite/gfortran.dg/select_rank_6.f90 new file mode 100644 index 00000000000..d0121777bb5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/select_rank_6.f90 @@ -0,0 +1,48 @@ +! { dg-do compile } +! PR fortran/100607 - fix diagnostics for SELECT RANK +! Contributed by T.Burnus + +program p + implicit none + integer, allocatable :: A(:,:,:) + + allocate(a(5:6,-2:2, 99:100)) + call foo(a) + call bar(a) + +contains + + subroutine foo(x) + integer, allocatable :: x(..) + if (rank(x) /= 3) stop 1 + if (any (lbound(x) /= [5, -2, 99])) stop 2 + + select rank (x) + rank(3) + if (any (lbound(x) /= [5, -2, 99])) stop 3 + end select + + select rank (x) ! { dg-error "pointer or allocatable selector at .2." } + rank(*) ! { dg-error "pointer or allocatable selector at .2." } + if (rank(x) /= 1) stop 4 + if (lbound(x, 1) /= 1) stop 5 + end select + end + + subroutine bar(x) + integer :: x(..) + if (rank(x) /= 3) stop 6 + if (any (lbound(x) /= 1)) stop 7 + + select rank (x) + rank(3) + if (any (lbound(x) /= 1)) stop 8 + end select + + select rank (x) + rank(*) + if (rank(x) /= 1) stop 9 + if (lbound(x, 1) /= 1) stop 10 + end select + end +end
reply other threads:[~2023-06-02 17:59 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20230602175916.BB02B3858D3C@sourceware.org \ --to=anlauf@gcc.gnu.org \ --cc=gcc-cvs@gcc.gnu.org \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: linkBe sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).