From 0110cfd5449bae3a772f45ea2e4c5dab5b7a8ccd Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Wed, 27 Jul 2022 21:34:22 +0200 Subject: Fortran: fix invalid rank error in ASSOCIATED when rank is remapped [PR77652] gcc/fortran/ChangeLog: PR fortran/77652 * check.cc (gfc_check_associated): Make the rank check of POINTER vs. TARGET match the allowed forms of pointer assignment for the selected Fortran standard. gcc/testsuite/ChangeLog: PR fortran/77652 * gfortran.dg/associated_target_9a.f90: New test. * gfortran.dg/associated_target_9b.f90: New test. --- gcc/fortran/check.cc | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc index 91d87a1..1da0b3c 100644 --- a/gcc/fortran/check.cc +++ b/gcc/fortran/check.cc @@ -1502,8 +1502,27 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target) t = false; /* F2018 C838 explicitly allows an assumed-rank variable as the first argument of intrinsic inquiry functions. */ - if (pointer->rank != -1 && !rank_check (target, 0, pointer->rank)) - t = false; + if (pointer->rank != -1 && pointer->rank != target->rank) + { + if (pointer->rank == 0 || target->rank == 0) + { + /* There exists no valid pointer assignment using bounds + remapping for scalar => array or array => scalar. */ + if (!rank_check (target, 0, pointer->rank)) + t = false; + } + else if (target->rank != 1) + { + if (!gfc_notify_std (GFC_STD_F2008, "Rank remapping target is not " + "rank 1 at %L", &target->where)) + t = false; + } + else if ((gfc_option.allow_std & GFC_STD_F2003) == 0) + { + if (!rank_check (target, 0, pointer->rank)) + t = false; + } + } if (target->rank > 0 && target->ref) { for (i = 0; i < target->rank; i++) -- cgit v1.1