diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ca1991d0c5d..66e61587fc0 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2007-05-01 Thomas Koenig + + PR fortran/31732 + * dependency.c (gfc_full_array_ref_p): If the reference is + to a single element, check that the array has a single + element and that the correct element is referenced. + 2007-05-01 Daniel Franke * intrinsic.c (add_functions): Fixed ELEMENTAL specifications. diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c index b79f2229835..bdda6d871d3 100644 --- a/gcc/fortran/dependency.c +++ b/gcc/fortran/dependency.c @@ -1126,6 +1126,24 @@ gfc_full_array_ref_p (gfc_ref *ref) for (i = 0; i < ref->u.ar.dimen; i++) { + /* If we have a single element in the reference, we need to check + that the array has a single element and that we actually reference + the correct element. */ + if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT) + { + if (!ref->u.ar.as + || !ref->u.ar.as->lower[i] + || !ref->u.ar.as->upper[i] + || gfc_dep_compare_expr (ref->u.ar.as->lower[i], + ref->u.ar.as->upper[i]) + || !ref->u.ar.start[i] + || gfc_dep_compare_expr (ref->u.ar.start[i], + ref->u.ar.as->lower[i])) + return false; + else + continue; + } + /* Check the lower bound. */ if (ref->u.ar.start[i] && (!ref->u.ar.as diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 617de905e50..82c9109817f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-05-01 Thomas Koenig + + PR fortran/31732 + * gfortran.dg/array_memset_2: New test case. + 2007-05-01 Dorit Nuzman PR testsuite/31615 diff --git a/gcc/testsuite/gfortran.dg/array_memset_2.f90 b/gcc/testsuite/gfortran.dg/array_memset_2.f90 new file mode 100644 index 00000000000..58ce8fe6442 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_memset_2.f90 @@ -0,0 +1,38 @@ +! { dg-do run } +! { dg-options "-O2 -fdump-tree-original" } + +module foo +contains + subroutine bar(a) + real, dimension(:,:) :: a + a(1,:) = 0. + end subroutine bar +end module foo + +program test + use foo + implicit none + real, dimension (2,2) :: a, d, e + real, dimension (1,2) :: b + real, dimension (2) :: c + data a, d, e /12*1.0/ + data b /2*1.0/ + data c /2*1.0/ + + a(1,:) = 0. ! This can't be optimized to a memset. + b(1,:) = 0. ! This is optimized to memset. + c = 0. ! This is optimized to memset. + d(:,1) = 0. ! This can't be otimized to a memset. + call bar(e) + + if (any(a /= reshape((/ 0.0, 1.0, 0.0, 1.0/), shape(a)))) call abort + if (any(b /= 0.)) call abort + if (any(c /= 0.)) call abort + if (any(d /= reshape((/ 0.0, 0.0, 1.0, 1.0/), shape(d)))) call abort + if (any(e /= reshape((/ 0.0, 1.0, 0.0, 1.0/), shape(e)))) call abort + +end program + +! { dg-final { scan-tree-dump-times "memset" 2 "original" } } +! { dg-final { cleanup-tree-dump "original" } } +! { dg-final { cleanup-modules "foo" } }