From 7a40f2e74815a926c5f47416c29efbc17aa1ef43 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Sun, 19 Sep 2021 17:32:03 -0700 Subject: Fortran: Fixes for F2018 C838 (PR fortran/101334) The compiler was failing to diagnose the error required by F2018 C838 when passing an assumed-rank array argument to a non-assumed-rank dummy. It was also incorrectly giving an error for calls to the 2-argument form of the ASSOCIATED intrinsic, which is supposed to be permitted by C838. 2021-09-19 Sandra Loosemore PR fortran/101334 gcc/fortran/ * check.c (gfc_check_associated): Allow an assumed-rank array for the pointer argument. * interface.c (compare_parameter): Also give rank mismatch error on assumed-rank array. gcc/testsuite/ * gfortran.dg/c-interop/c535b-2.f90: Remove xfails. * gfortran.dg/c-interop/c535b-3.f90: Likewise. --- gcc/fortran/check.c | 4 +++- gcc/fortran/interface.c | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 851af1b..f31ad68 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -1520,7 +1520,9 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target) t = true; if (!same_type_check (pointer, 0, target, 1, true)) t = false; - if (!rank_check (target, 0, pointer->rank)) + /* 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 (target->rank > 0) { diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 9e3e8aa..f9a7c9c 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2634,7 +2634,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, && formal->as->type == AS_ASSUMED_SHAPE)) && actual->expr_type != EXPR_NULL) || (actual->rank == 0 && formal->attr.dimension - && gfc_is_coindexed (actual))) + && gfc_is_coindexed (actual)) + /* Assumed-rank actual argument; F2018 C838. */ + || actual->rank == -1) { if (where && (!formal->attr.artificial || (!formal->maybe_array -- cgit v1.1