PR fortran/PR44693

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

gcc/fortran/ChangeLog

+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

gcc/fortran/check.c

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

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/dim_range_1.f90

+! { 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

gcc/testsuite/gfortran.dg/minmaxloc_4.f90

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