Re: [Patch, Fortran] Simplify lbound

[Mikael Morin <mikael dot morin at sfr dot fr>]

Le 03/05/2015 22:38, Thomas Koenig a Ãcrit :
> Hi Mikael,
> 
> Looks good.
> 
> In general, it is better to restrict changes to existing test cases to
> the necessary minimum that they still pass, and add new code to new
> test cases.  This makes regressions easier to track.
> 
> So, OK with that change.
> 
Here is what I have committed.

Mikael

Index: testsuite/gfortran.dg/bound_simplification_5.f90
===================================================================
--- testsuite/gfortran.dg/bound_simplification_5.f90	(révision 0)
+++ testsuite/gfortran.dg/bound_simplification_5.f90	(révision 222979)
@@ -0,0 +1,75 @@
+! { dg-do run }
+! { dg-additional-options "-fcoarray=single -fdump-tree-original" }
+!
+! Check that {L,U}{,CO}BOUND intrinsics are properly simplified.
+!
+  implicit none
+
+  type :: t
+    integer :: c
+  end type t
+
+  type(t) :: d(3:8) = t(7)
+  type(t) :: e[5:9,-1:*]
+  type(t) :: h(3), j(4), k(0)
+
+  !Test full arrays vs subarrays
+  if (lbound(d,      1) /= 3) call abort
+  if (lbound(d(3:5), 1) /= 1) call abort
+  if (lbound(d%c,    1) /= 1) call abort
+  if (ubound(d,      1) /= 8) call abort
+  if (ubound(d(3:5), 1) /= 3) call abort
+  if (ubound(d%c,    1) /= 6) call abort  
+
+  if (lcobound(e,   1) /=  5) call abort
+  if (lcobound(e%c, 1) /=  5) call abort
+  if (lcobound(e,   2) /= -1) call abort
+  if (lcobound(e%c, 2) /= -1) call abort
+  if (ucobound(e,   1) /=  9) call abort
+  if (ucobound(e%c, 1) /=  9) call abort
+  ! no simplification for ucobound(e{,%c}, dim=2)
+
+  if (any(lbound(d     ) /= [3])) call abort
+  if (any(lbound(d(3:5)) /= [1])) call abort
+  if (any(lbound(d%c   ) /= [1])) call abort
+  if (any(ubound(d     ) /= [8])) call abort
+  if (any(ubound(d(3:5)) /= [3])) call abort
+  if (any(ubound(d%c   ) /= [6])) call abort  
+
+  if (any(lcobound(e  ) /=  [5, -1])) call abort
+  if (any(lcobound(e%c) /=  [5, -1])) call abort
+  ! no simplification for ucobound(e{,%c})
+
+  call test_empty_arrays(h, j, k)
+
+contains
+  subroutine test_empty_arrays(a, c, d)
+    type(t) :: a(:), c(-3:0), d(3:1)
+    type(t) :: f(4:2), g(0:6)
+
+    if (lbound(a, 1) /=  1) call abort
+    if (lbound(c, 1) /= -3) call abort
+    if (lbound(d, 1) /=  1) call abort
+    if (lbound(f, 1) /=  1) call abort
+    if (lbound(g, 1) /=  0) call abort
+
+    if (ubound(c, 1) /=  0) call abort
+    if (ubound(d, 1) /=  0) call abort
+    if (ubound(f, 1) /=  0) call abort
+    if (ubound(g, 1) /=  6) call abort
+
+    if (any(lbound(a) /= [ 1])) call abort
+    if (any(lbound(c) /= [-3])) call abort
+    if (any(lbound(d) /= [ 1])) call abort
+    if (any(lbound(f) /= [ 1])) call abort
+    if (any(lbound(g) /= [ 0])) call abort
+
+    if (any(ubound(c) /= [0])) call abort
+    if (any(ubound(d) /= [0])) call abort
+    if (any(ubound(f) /= [0])) call abort
+    if (any(ubound(g) /= [6])) call abort
+
+  end subroutine
+end
+! { dg-final { scan-tree-dump-not "abort" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
Index: testsuite/ChangeLog
===================================================================
--- testsuite/ChangeLog	(révision 222978)
+++ testsuite/ChangeLog	(révision 222979)
@@ -1,3 +1,7 @@
+2015-05-10  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* gfortran.dg/bound_simplification_5.f90: New.
+
 2015-05-09  Jason Merrill  <jason@redhat.com>
 
 	* lib/target-supports.exp (cxx_default): New global.
Index: fortran/ChangeLog
===================================================================
--- fortran/ChangeLog	(révision 222978)
+++ fortran/ChangeLog	(révision 222979)
@@ -1,3 +1,11 @@
+2015-05-10  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* simplify.c (simplify_bound_dim): Don't check for emptyness
+	in the case of cobound simplification.  Factor lower/upper
+	bound differenciation before the actual simplification.
+	(simplify_bound): Remove assumed shape specific simplification.  
+	Don't give up early for the lbound of an assumed shape.
+
 2015-05-09  Mikael Morin  <mikael@gcc.gnu.org>
 
 	PR fortran/65894
Index: fortran/simplify.c
===================================================================
--- fortran/simplify.c	(révision 222978)
+++ fortran/simplify.c	(révision 222979)
@@ -3340,29 +3340,43 @@
   /* Then, we need to know the extent of the given dimension.  */
   if (coarray || (ref->u.ar.type == AR_FULL && !ref->next))
     {
+      gfc_expr *declared_bound;
+      int empty_bound;
+      bool constant_lbound, constant_ubound;
+
       l = as->lower[d-1];
       u = as->upper[d-1];
 
-      if (l->expr_type != EXPR_CONSTANT || u == NULL
-	  || u->expr_type != EXPR_CONSTANT)
+      gcc_assert (l != NULL);
+
+      constant_lbound = l->expr_type == EXPR_CONSTANT;
+      constant_ubound = u && u->expr_type == EXPR_CONSTANT;
+
+      empty_bound = upper ? 0 : 1;
+      declared_bound = upper ? u : l;
+
+      if ((!upper && !constant_lbound)
+	  || (upper && !constant_ubound))
 	goto returnNull;
 
-      if (mpz_cmp (l->value.integer, u->value.integer) > 0)
+      if (!coarray)
 	{
-	  /* Zero extent.  */
-	  if (upper)
-	    mpz_set_si (result->value.integer, 0);
+	  /* For {L,U}BOUND, the value depends on whether the array
+	     is empty.  We can nevertheless simplify if the declared bound
+	     has the same value as that of an empty array, in which case
+	     the result isn't dependent on the array emptyness.  */
+	  if (mpz_cmp_si (declared_bound->value.integer, empty_bound) == 0)
+	    mpz_set_si (result->value.integer, empty_bound);
+	  else if (!constant_lbound || !constant_ubound)
+	    /* Array emptyness can't be determined, we can't simplify.  */
+	    goto returnNull;
+	  else if (mpz_cmp (l->value.integer, u->value.integer) > 0)
+	    mpz_set_si (result->value.integer, empty_bound);
 	  else
-	    mpz_set_si (result->value.integer, 1);
+	    mpz_set (result->value.integer, declared_bound->value.integer);
 	}
       else
-	{
-	  /* Nonzero extent.  */
-	  if (upper)
-	    mpz_set (result->value.integer, u->value.integer);
-	  else
-	    mpz_set (result->value.integer, l->value.integer);
-	}
+	mpz_set (result->value.integer, declared_bound->value.integer);
     }
   else
     {
@@ -3442,43 +3456,16 @@
 
  done:
 
-  /* If the array shape is assumed shape or explicit, we can simplify lbound
-     to 1 if the given lower bound is one because this matches what lbound
-     should return for an empty array.  */
+  if (as && (as->type == AS_DEFERRED || as->type == AS_ASSUMED_RANK
+	     || (as->type == AS_ASSUMED_SHAPE && upper)))
+    return NULL;
 
-  if (!upper && as && dim && dim->expr_type == EXPR_CONSTANT
-      && (as->type == AS_ASSUMED_SHAPE || as->type == AS_EXPLICIT) 
-      && ref->u.ar.type != AR_SECTION)
-    {
-      /* Watch out for allocatable or pointer dummy arrays, they can have
-	 lower bounds that are not equal to one.  */
-      if (!(array->symtree && array->symtree->n.sym
-	    && (array->symtree->n.sym->attr.allocatable
-		|| array->symtree->n.sym->attr.pointer)))
-	{
-	  unsigned long int ndim;
-	  gfc_expr *lower, *res;
+  gcc_assert (!as
+	      || (as->type != AS_DEFERRED
+		  && array->expr_type == EXPR_VARIABLE
+		  && !array->symtree->n.sym->attr.allocatable
+		  && !array->symtree->n.sym->attr.pointer));
 
-	  ndim = mpz_get_si (dim->value.integer) - 1;
-	  lower = as->lower[ndim];
-	  if (lower->expr_type == EXPR_CONSTANT
-	      && mpz_cmp_si (lower->value.integer, 1) == 0)
-	    {
-	      res = gfc_copy_expr (lower);
-	      if (kind)
-		{
-		  int nkind = mpz_get_si (kind->value.integer);
-		  res->ts.kind = nkind;
-		}
-	      return res;
-	    }
-	}
-    }
-
-  if (as && (as->type == AS_DEFERRED || as->type == AS_ASSUMED_SHAPE
-	     || as->type == AS_ASSUMED_RANK))
-    return NULL;
-
   if (dim == NULL)
     {
       /* Multi-dimensional bounds.  */