re PR fortran/37131 (inline matmul for small matrix sizes)

2015-04-30  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/37131
	* simplify.c (simplify_bound): Get constant lower bounds of one
	from array spec for assumed and explicit shape shape arrays if
	the lower bounds are indeed one.

2015-04-30  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/37131
	* gfortran.dg/coarray_lib_this_image_2.f90:  Adjust
	scan pattern.
	* gfortran.dg/bound_9.f90:  New test case.

From-SVN: r222661

gcc/fortran/ChangeLog

+2015-04-30  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/37131
+	* simplify.c (simplify_bound): Get constant lower bounds of one
+	from array spec for assumed and explicit shape shape arrays if
+	the lower bounds are indeed one.
+
 2015-04-30  David Malcolm  <dmalcolm@redhat.com>
 
 	* options.c (gfc_init_options): Remove spurious second

gcc/fortran/simplify.c

@@ -3445,6 +3445,39 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
 
  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 (!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;
+
+	  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;

gcc/testsuite/ChangeLog

+2015-04-30  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/37131
+	* gfortran.dg/coarray_lib_this_image_2.f90:  Adjust
+	scan pattern.
+	* gfortran.dg/bound_9.f90:  New test case.
+
 2015-04-29  Uros Bizjak  <ubizjak@gmail.com>
 
 	* g++.dg/ipa/devirt-28a.C: Require LTO effective target.

gcc/testsuite/gfortran.dg/bound_9.f90

+! { dg-do  run }
+! { dg-options "-fdump-tree-original" }
+! Check for different combinations of lbound for dummy arrays,
+! stressing empty arrays.  The assignments with "one =" should
+! be simplified at compile time.
+module tst
+  implicit none
+contains
+  subroutine foo (a, b, one, m)
+    integer, dimension(:), intent(in) :: a
+    integer, dimension (-2:), intent(in) :: b
+    integer, intent(out) :: one, m
+    one = lbound(a,1)
+    m = lbound(b,1)
+  end subroutine foo
+
+  subroutine bar (a, b, n, m)
+    integer, dimension(:), allocatable, intent(inout) :: a
+    integer, dimension(:), pointer, intent(inout) :: b
+    integer, intent(out) :: n, m
+    n = lbound(a,1)
+    m = lbound(b,1)
+  end subroutine bar
+
+  subroutine baz (a, n, m, s)
+    integer, intent(in) :: n,m
+    integer, intent(out) :: s
+    integer, dimension(n:m) :: a
+    s = lbound(a,1)
+  end subroutine baz
+
+  subroutine qux (a, s, one)
+    integer, intent(in) :: s
+    integer, dimension(s) :: a
+    integer, intent(out) :: one
+    one = lbound(a,1)
+  end subroutine qux
+end module tst
+
+program main
+  use tst
+  implicit none
+  integer, dimension(3), target :: a, b
+  integer, dimension(0) :: empty
+  integer, dimension(:), allocatable :: x
+  integer, dimension(:), pointer :: y
+  integer :: n,m
+  
+
+  call foo(a,b,n,m)
+  if (n .ne. 1 .or. m .ne. -2) call abort
+  call foo(a(2:0), empty, n, m)
+  if (n .ne. 1 .or. m .ne. 1) call abort
+  call foo(empty, a(2:0), n, m)
+  if (n .ne. 1 .or. m .ne. 1) call abort
+  allocate (x(0))
+  call bar (x, y, n, m)
+  if (n .ne. 1 .or. m .ne. 1) call abort
+
+  call baz(a,3,2,n)
+  if (n .ne. 1) call abort
+
+  call baz(a,2,3,n)
+  if (n .ne. 2) call abort
+
+  call qux(a, -3, n)
+  if (n .ne. 1) call abort
+end program main
+! { dg-final { scan-tree-dump-times "\\*one = 1" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }

gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90

@@ -20,7 +20,7 @@ end
 ! { dg-final { scan-tree-dump-times "mylcobound = 5;" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "parm...dim\\\[1\\\].lbound = 5;" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "myucobound =\[^\n\r\]* parm...dim\\\[1\\\].lbound \\+ \[^\n\r\]*_gfortran_caf_num_images \\(0, -1\\).? \\+ -?\[0-9\]+\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "mylbound = parm...dim\\\[0\\\].stride >= 0 && parm...dim\\\[0\\\].ubound >= parm...dim\\\[0\\\].lbound \\|\\| parm...dim\\\[0\\\].stride < 0 \\?\[^\n\r\]* parm...dim\\\[0\\\].lbound : 1;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mylbound = 1;" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "mythis_image = _gfortran_caf_this_image \\(0\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "bar \\(&parm.\[0-9\]+, caf_token.\[0-9\]+, \\(integer\\(kind=\[48\]\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=\[48\]\\)\\) x\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_init \\(&argc, &argv\\);" 1 "original" } }