From 48e76d2f70c028a5d84027e79f7fe386278dc15e Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Thu, 2 Jan 2020 15:40:51 +0000 Subject: [PATCH] =?utf8?q?Fortran]=20PR68020=20=E2=80=93=20Fix=20implied-s?= =?utf8?q?hape=20handling=20for=20rank=20>=202?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit PR fortran/68020 * array.c (gfc_match_array_spec): Fix implied-type matching for rank > 2. PR fortran/68020 * gfortran.dg/implied_shape_4.f90: New. * gfortran.dg/implied_shape_5.f90: New. From-SVN: r279835 --- gcc/fortran/ChangeLog | 6 ++++ gcc/fortran/array.c | 2 +- gcc/testsuite/ChangeLog | 6 ++++ gcc/testsuite/gfortran.dg/implied_shape_4.f90 | 45 +++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/implied_shape_5.f90 | 29 +++++++++++++++++ 5 files changed, 87 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/implied_shape_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/implied_shape_5.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ba363f8..c76ffcb 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2020-01-02 Tobias Burnus + + PR fortran/68020 + * array.c (gfc_match_array_spec): Fix implied-type matching + for rank > 2. + 2020-01-01 Thomas Koenig PR fortran/93113 diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index c273fd1..e5b4ad7 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -599,7 +599,7 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim) goto cleanup; case AS_IMPLIED_SHAPE: - if (current_type != AS_ASSUMED_SHAPE) + if (current_type != AS_ASSUMED_SIZE) { gfc_error ("Bad array specification for implied-shape" " array at %C"); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e943998..4141bc8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2020-01-02 Tobias Burnus + + PR fortran/68020 + * gfortran.dg/implied_shape_4.f90: New. + * gfortran.dg/implied_shape_5.f90: New. + 2020-01-02 Jakub Jelinek PR ipa/93087 diff --git a/gcc/testsuite/gfortran.dg/implied_shape_4.f90 b/gcc/testsuite/gfortran.dg/implied_shape_4.f90 new file mode 100644 index 0000000..2552c2a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/implied_shape_4.f90 @@ -0,0 +1,45 @@ +! { dg-do run } +! { dg-additional-options "-std=f2008" } +! +! PR fortran/68020 +! +! Contributed by Gerhard Steinmetz +! +subroutine rank_1_2 + integer, parameter :: a(1, 2) = 0 + integer, parameter :: x(*, *) = a + integer, parameter :: y(11:*, 12:*) = a + integer :: k + if (any (lbound(x) /= [1,1])) stop 1 + if (any (ubound(x) /= [1,2])) stop 2 + if (any (lbound(y) /= [11,12])) stop 3 + if (any (ubound(y) /= [11,13])) stop 4 +end + +subroutine rank_3 + integer, parameter :: a(1, 2, 3) = 0 + integer, parameter :: x(*, *, *) = a + integer, parameter :: y(11:*, 12:*, 13:*) = a + integer :: k + if (any (lbound(x) /= [1,1,1])) stop 5 + if (any (ubound(x) /= [1,2,3])) stop 6 + if (any (lbound(y) /= [11,12,13])) stop 7 + if (any (ubound(y) /= [11,13,15])) stop 8 +end + +subroutine rank_4 + integer, parameter :: a(1, 2, 3, 4) = 0 + integer, parameter :: x(*, *, *, *) = a + integer, parameter :: y(11:*, 12:*, 13:*, 14:*) = a + integer :: k + if (any (lbound(x) /= [1,1,1,1])) stop 9 + if (any (ubound(x) /= [1,2,3,4])) stop 10 + if (any (lbound(y) /= [11,12,13,14])) stop 11 + if (any (ubound(y) /= [11,13,15,17])) stop 12 +end + +program p + call rank_1_2 + call rank_3 + call rank_4 +end program p diff --git a/gcc/testsuite/gfortran.dg/implied_shape_5.f90 b/gcc/testsuite/gfortran.dg/implied_shape_5.f90 new file mode 100644 index 0000000..b36c363 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/implied_shape_5.f90 @@ -0,0 +1,29 @@ +! { dg-do run } +! +! PR fortran/68020 +! +! Reject mixing explicit-shape and implied-shape arrays +! +subroutine rank_1_2 + integer, parameter :: a(1, 2) = 0 + integer, parameter :: y(11:11, 12:*) = a ! { dg-error "Assumed size array at .1. must be a dummy argument" } + integer, parameter :: x(:, *) = a ! { dg-error "Bad specification for deferred shape array" } +end + +subroutine rank_3 + integer, parameter :: a(1, 2, 3) = 0 + integer, parameter :: y(11:*, 12:14, 13:*) = a ! { dg-error "Bad specification for assumed size array" } + integer, parameter :: x(11:*, :, 13:*) = a ! { dg-error "Bad specification for assumed size array" } +end + +subroutine rank_4 + integer, parameter :: a(1, 2, 3, 4) = 0 + integer, parameter :: y(11:*, 12:*, 13:*, 14:17) = a ! { dg-error "Bad array specification for implied-shape array" } + integer, parameter :: y(11:*, 12:*, 13:*, 14:) = a ! { dg-error "Bad array specification for implied-shape array" } +end + +program p + call rank_1_2 + call rank_3 + call rank_4 +end program p -- 2.7.4