From a312407bd715647f7c11b67e0a52effc94d0f15d Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Mon, 20 Jun 2022 20:59:55 +0200
Subject: [PATCH] Fortran: handle explicit-shape specs with constant bounds
 [PR105954]

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                    | 12 ++++++++++++
 gcc/testsuite/gfortran.dg/pr105954.f90 | 26 ++++++++++++++++++++++++++
 2 files changed, 38 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/pr105954.f90

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index bd586e7..26ff54d 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -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
index 0000000..89004bf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr105954.f90
@@ -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" } }
-- 
2.7.4