From 3a7a95a220c14043da1e1166530e1d76f001dad9 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?= Date: Sun, 30 Aug 2020 18:03:13 +0000 Subject: [PATCH] =?utf8?q?=092020-8-20=20=20Jos=C3=A9=20Rui=20Faustino=20d?= =?utf8?q?e=20Sousa=20=20?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit gcc/fortran/ChangeLog: PR fortran/96727 * expr.c (gfc_check_init_expr): Add default error message for the AS_ASSUMED_RANK case. gcc/testsuite/ChangeLog: PR fortran/96727 * gfortran.dg/PR96727.f90: New test. --- gcc/fortran/expr.c | 6 +++++ gcc/testsuite/gfortran.dg/PR96727.f90 | 34 +++++++++++++++++++++++++++ 2 files changed, 40 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/PR96727.f90 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 2ef01f0f14f..68784a235f1 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3007,6 +3007,12 @@ gfc_check_init_expr (gfc_expr *e) e->symtree->n.sym->name, &e->where); break; + case AS_ASSUMED_RANK: + gfc_error ("Assumed-rank array %qs at %L is not permitted " + "in an initialization expression", + e->symtree->n.sym->name, &e->where); + break; + default: gcc_unreachable(); } diff --git a/gcc/testsuite/gfortran.dg/PR96727.f90 b/gcc/testsuite/gfortran.dg/PR96727.f90 new file mode 100644 index 00000000000..d45dbb7ccd6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR96727.f90 @@ -0,0 +1,34 @@ +! { dg-do run } +! +! Test the fix for PR96727 +! + +program cref_p + + implicit none + + integer :: i + + integer, parameter :: n = 3 + integer, parameter :: p(*) = [(i, i=1,n*n)] + character(len=*), parameter :: q = repeat('a', n*n) + + integer :: a(n,n) + character(len=n*n) :: c + + a = reshape(p, shape=[n,n]) + call csub(a, c) + if (c/=q) stop 1 + stop + +contains + + subroutine csub(a, b) + integer, intent(in) :: a(..) + character(len=size(a)), intent(out) :: b + + b = repeat('a', len(b)) + return + end subroutine csub + +end program cref_p -- 2.30.2