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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 76cf93652611ee5e30736f6c7e6fc8609349e167..021d20d22b1094401e54ebfbfcafa81657c05f60 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 92b3076b634f1c66950ce948a579ed6f74afa4ca..f631ac80cdca3f17f73abeab7ba42b8740a0523a 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d0da860a06266a07d7c126a9f2b88bb22242daa0..fdf9c4f9b0889fd1a8bb95fc07cfed664b701b55 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+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.

diff --git a/gcc/testsuite/gfortran.dg/bound_9.f90 b/gcc/testsuite/gfortran.dg/bound_9.f90
new file mode 100644 (file)
index 0000000..d413ca4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bound_9.f90
@@ -0,0 +1,70 @@
+! { 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" } }

diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
index 4afabaadff54fdef5520e51489a31f5fc2109aec..6e72a153a25c9e572acb528d4439c048bb6bfa05 100644 (file)
--- a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
+++ b/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" } }