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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@161884 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 37 insertions, 10 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7714abf4d38..0d43b6c63e6 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 34527172431..27bd900f9e3 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 6fc6b3bfdec..80822314516 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 00000000000..59f3f431143
--- /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 2ea2e7b86ab..673739518dc 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