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

5 files changed, 37 insertions, 10 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7714abf..0d43b6c 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 3452717..27bd900 100644
--- a/gcc/fortran/check.c
+++ b/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);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6fc6b3b..8082231 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/dim_range_1.f90 b/gcc/testsuite/gfortran.dg/dim_range_1.f90
new file mode 100644
index 0000000..59f3f43
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dim_range_1.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_4.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_4.f90
index 2ea2e7b..6737395 100644
--- a/gcc/testsuite/gfortran.dg/minmaxloc_4.f90
+++ b/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