+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
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);
--- /dev/null
+! { 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
PROGRAM TST
IMPLICIT NONE
REAL :: A(1,3)
- REAL :: B(3,1)
A(:,1) = 10
A(:,2) = 20
A(:,3) = 30
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