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

PR fortran/PR44693

Browse source 
2010-07-06  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/PR44693
	* check.c (dim_rank_check):  Also check intrinsic functions.
	Adjust permissible rank for functions which reduce the rank of
	their argument.  Spread is an exception, where DIM can
	be one larger than the rank of array.

2010-07-06  Thomas Koenig  <tkoenig@gcc.gnu.org>
	PR fortran/PR44693
	* gfortran.dg/dim_range_1.f90:  New test.
	* gfortran.dg/minmaxloc_4.f90:  Remove invalid test.

From-SVN: r161884
This commit is contained in:
Thomas Koenig 2010-07-06 19:48:58 +00:00
parent 0060a10ae8
commit 7114ab4579
5 changed files with 37 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View file

@ -1,3 +1,11 @@
2010-07-06 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/PR44693
* check.c (dim_rank_check): Also check intrinsic functions.
Adjust permissible rank for functions which reduce the rank of
their argument. Spread is an exception, where DIM can
be one larger than the rank of array.
2010-07-05 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/44797

11
gcc/fortran/check.c
View file

@ -473,12 +473,15 @@ dim_rank_check (gfc_expr *dim, gfc_expr *array, int allow_assumed)
if (dim == NULL)
return SUCCESS;
if (dim->expr_type != EXPR_CONSTANT
|| (array->expr_type != EXPR_VARIABLE
&& array->expr_type != EXPR_ARRAY))
if (dim->expr_type != EXPR_CONSTANT)
return SUCCESS;
rank = array->rank;
if (array->expr_type == EXPR_FUNCTION && array->value.function.isym
&& array->value.function.isym->id == GFC_ISYM_SPREAD)
rank = array->rank + 1;
else
rank = array->rank;
if (array->expr_type == EXPR_VARIABLE)
{
ar = gfc_find_array_ref (array);

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2010-07-06 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/PR44693
* gfortran.dg/dim_range_1.f90: New test.
* gfortran.dg/minmaxloc_4.f90: Remove invalid test.
2010-07-06 Jason Merrill <jason@redhat.com>
PR c++/44703

17
gcc/testsuite/gfortran.dg/dim_range_1.f90 Normal file
View file

@ -0,0 +1,17 @@
! { dg-do compile }
! PR 44693 - check for invalid dim even in functions.
! Based on a test case by Dominique d'Humieres.
subroutine test1(esss,Ix,Iyz, n)
real(kind=kind(1.0d0)), dimension(n), intent(out) :: esss
real(kind=kind(1.0d0)), dimension(n,n,n) :: sp
real(kind=kind(1.0d0)), dimension(n,n) :: Ix,Iyz
esss = sum(Ix * Iyz, 0) ! { dg-error "is not a valid dimension index" }
esss = sum(Ix * Iyz, 1)
esss = sum(Ix * Iyz, 2)
esss = sum(Ix * Iyz, 3) ! { dg-error "is not a valid dimension index" }
sp = spread (ix * iyz, 0, n) ! { dg-error "is not a valid dimension index" }
sp = spread (ix * iyz, 1, n)
sp = spread (ix * iyz, 2, n)
sp = spread (ix * iyz, 3, n)
sp = spread (ix * iyz, 4, n) ! { dg-error "is not a valid dimension index" }
end subroutine

6
gcc/testsuite/gfortran.dg/minmaxloc_4.f90
View file

@ -3,7 +3,6 @@
PROGRAM TST
IMPLICIT NONE
REAL :: A(1,3)
REAL :: B(3,1)
A(:,1) = 10
A(:,2) = 20
A(:,3) = 30
@ -13,9 +12,4 @@ PROGRAM TST
if (minloc(sum(a(:,1:3),1),1) .ne. 1) call abort()
if (maxloc(sum(a(:,1:3),1),1) .ne. 3) call abort()
B(1,:) = 10
B(2,:) = 20
B(3,:) = 30
if (minloc(sum(b(1:3,:),2),2) .ne. 1) call abort()
if (maxloc(sum(b(1:3,:),2),2) .ne. 3) call abort()
END PROGRAM TST