Fortran] PR68020 – Fix implied-shape handling for rank > 2
authorTobias Burnus <tobias@codesourcery.com>
Thu, 2 Jan 2020 15:40:51 +0000 (15:40 +0000)
committerTobias Burnus <burnus@gcc.gnu.org>
Thu, 2 Jan 2020 15:40:51 +0000 (16:40 +0100)
        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
gcc/fortran/array.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/implied_shape_4.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/implied_shape_5.f90 [new file with mode: 0644]

index ba363f88261a9e658a361afea24d967c5ca5f4f8..c76ffcbb3e1a430512ccb725a066f4e7c7d8c24f 100644 (file)
@@ -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
index c273fd116daa42699e83a3de737996d7f2e13c0d..e5b4ad7b4b2a4ed10f253a30ae52c3d6db0c45a7 100644 (file)
@@ -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");
index e943998ac6f98df88ea806732c4932bb30e55b9a..4141bc87c2fce991a49e642ea8f9bebaf29cb8da 100644 (file)
@@ -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 (file)
index 0000000..2552c2a
--- /dev/null
@@ -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 (file)
index 0000000..b36c363
--- /dev/null
@@ -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