FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
This commit is contained in:
Thomas Koenig 2015-04-30 22:12:31 +00:00
parent 6f3d1a5e66
commit 0ba691a097
5 changed files with 118 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View file

@ -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

33
gcc/fortran/simplify.c
View file

@ -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;

7
gcc/testsuite/ChangeLog
View file

@ -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.

70
gcc/testsuite/gfortran.dg/bound_9.f90 Normal file
View file

@ -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" } }

2
gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
View file

@ -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" } }