From 48e76d2f70c028a5d84027e79f7fe386278dc15e Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Thu, 2 Jan 2020 15:40:51 +0000
Subject: [PATCH] =?UTF-8?q?Fortran]=20PR68020=20=E2=80=93=20Fix=20implied-?=
=?UTF-8?q?shape=20handling=20for=20rank=20>=202?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
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 ba363f88261a..c76ffcbb3e1a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2020-01-02 Tobias Burnus <tobias@codesourcery.com>
+
+ PR fortran/68020
+ * array.c (gfc_match_array_spec): Fix implied-type matching
+ for rank > 2.
+
2020-01-01 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/93113
diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index c273fd116daa..e5b4ad7b4b2a 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 e943998ac6f9..4141bc87c2fc 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2020-01-02 Tobias Burnus <tobias@codesourcery.com>
+
+ PR fortran/68020
+ * gfortran.dg/implied_shape_4.f90: New.
+ * gfortran.dg/implied_shape_5.f90: New.
+
2020-01-02 Jakub Jelinek <jakub@redhat.com>
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 000000000000..2552c2ac1e25
--- /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 000000000000..b36c36389b38
--- /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
--
GitLab