Fortran: handle explicit-shape specs with constant bounds [PR105954]
authorHarald Anlauf <anlauf@gmx.de>
Mon, 20 Jun 2022 18:59:55 +0000 (20:59 +0200)
committerHarald Anlauf <anlauf@gmx.de>
Sun, 26 Jun 2022 20:01:49 +0000 (22:01 +0200)
gcc/fortran/ChangeLog:

PR fortran/105954
* decl.cc (variable_decl): Adjust upper bounds for explicit-shape
specs with constant bound expressions to ensure non-negative
extents.

gcc/testsuite/ChangeLog:

PR fortran/105954
* gfortran.dg/pr105954.f90: New test.

gcc/fortran/decl.cc
gcc/testsuite/gfortran.dg/pr105954.f90 [new file with mode: 0644]

index bd586e7..26ff54d 100644 (file)
@@ -2775,6 +2775,18 @@ variable_decl (int elem)
                  else
                    gfc_free_expr (n);
                }
+             /* For an explicit-shape spec with constant bounds, ensure
+                that the effective upper bound is not lower than the
+                respective lower bound minus one.  Otherwise adjust it so
+                that the extent is trivially derived to be zero.  */
+             if (as->lower[i]->expr_type == EXPR_CONSTANT
+                 && as->upper[i]->expr_type == EXPR_CONSTANT
+                 && as->lower[i]->ts.type == BT_INTEGER
+                 && as->upper[i]->ts.type == BT_INTEGER
+                 && mpz_cmp (as->upper[i]->value.integer,
+                             as->lower[i]->value.integer) < 0)
+               mpz_sub_ui (as->upper[i]->value.integer,
+                           as->lower[i]->value.integer, 1);
            }
        }
     }
diff --git a/gcc/testsuite/gfortran.dg/pr105954.f90 b/gcc/testsuite/gfortran.dg/pr105954.f90
new file mode 100644 (file)
index 0000000..89004bf
--- /dev/null
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+! PR fortran/105954 - ICE in gfc_element_size, at fortran/target-memory.cc:132
+! Contributed by G.Steinmetz
+
+program p
+  use iso_c_binding, only: c_float, c_sizeof
+  implicit none
+  integer, parameter :: n = -99
+  type t
+     real :: b(3,7:n)
+  end type
+  type, bind(c) :: u
+     real(c_float) :: b(3,7:n)
+  end type
+  type(t) :: d
+  type(u) :: e
+  integer, parameter :: k = storage_size(d)
+  integer, parameter :: m = sizeof(d)
+  integer, parameter :: l = c_sizeof(e)
+  if (k /= 0) stop 1
+  if (m /= 0) stop 2
+  if (l /= 0) stop 3
+end
+
+! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "original" } }