From 9f1dce5609ca54d2caa87d0ecfece64a7bb58c81 Mon Sep 17 00:00:00 2001
From: Francois-Xavier Coudert <coudert@clipper.ens.fr>
Date: Thu, 16 Nov 2006 13:25:11 +0100
Subject: re PR fortran/29391 ([4.2/4.1 only] LBOUND and UBOUND are broken)

	PR fortran/29391
	PR fortran/29489

	* simplify.c (simplify_bound): Fix the simplification of
	LBOUND/UBOUND intrinsics.
	* trans-intrinsic.c (simplify_bound): Fix the logic, and
	remove an erroneous assert.

	* gcc/testsuite/gfortran.dg/bound_2.f90: Add more checks.
	* gcc/testsuite/gfortran.dg/bound_3.f90: New test.

From-SVN: r118888
---
 gcc/fortran/simplify.c | 45 ++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 38 insertions(+), 7 deletions(-)

(limited to 'gcc/fortran/simplify.c')

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 75e4c3c..8ecabf0 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -1913,12 +1913,9 @@ simplify_bound (gfc_expr * array, gfc_expr * dim, int upper)
 {
   gfc_ref *ref;
   gfc_array_spec *as;
-  gfc_expr *e;
+  gfc_expr *l, *u, *result;
   int d;
 
-  if (array->expr_type != EXPR_VARIABLE)
-    return NULL;
-
   if (dim == NULL)
     /* TODO: Simplify constant multi-dimensional bounds.  */
     return NULL;
@@ -1926,6 +1923,9 @@ simplify_bound (gfc_expr * array, gfc_expr * dim, int upper)
   if (dim->expr_type != EXPR_CONSTANT)
     return NULL;
 
+  if (array->expr_type != EXPR_VARIABLE)
+    return NULL;
+
   /* Follow any component references.  */
   as = array->symtree->n.sym->as;
   for (ref = array->ref; ref; ref = ref->next)
@@ -1975,12 +1975,43 @@ simplify_bound (gfc_expr * array, gfc_expr * dim, int upper)
       return &gfc_bad_expr;
     }
 
-  e = upper ? as->upper[d-1] : as->lower[d-1];
+  /* The last dimension of an assumed-size array is special.  */
+  if (d == as->rank && as->type == AS_ASSUMED_SIZE && !upper)
+    {
+      if (as->lower[d-1]->expr_type == EXPR_CONSTANT)
+	return gfc_copy_expr (as->lower[d-1]);
+      else
+	return NULL;
+    }
 
-  if (e->expr_type != EXPR_CONSTANT)
+  /* Then, we need to know the extent of the given dimension.  */
+  l = as->lower[d-1];
+  u = as->upper[d-1];
+
+  if (l->expr_type != EXPR_CONSTANT || u->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  return gfc_copy_expr (e);
+  result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
+				&array->where);
+
+  if (mpz_cmp (l->value.integer, u->value.integer) > 0)
+    {
+      /* Zero extent.  */
+      if (upper)
+	mpz_set_si (result->value.integer, 0);
+      else
+	mpz_set_si (result->value.integer, 1);
+    }
+  else
+    {
+      /* Nonzero extent.  */
+      if (upper)
+	mpz_set (result->value.integer, u->value.integer);
+      else
+	mpz_set (result->value.integer, l->value.integer);
+    }
+
+  return range_check (result, upper ? "UBOUND" : "LBOUND");
 }
 
 
-- 
cgit v1.1