From patchwork Tue Jul  6 19:11:06 2010
Content-Type: text/plain; charset="utf-8"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Subject: Fix PR fortran/44693, take 2
Date: Tue, 06 Jul 2010 09:11:06 -0000
From: Thomas Koenig <tkoenig@netcologne.de>
X-Patchwork-Id: 58054
Message-Id: <1278443466.4634.9.camel@linux-fd1f.site>
To: fortran@gcc.gnu.org
Cc: gcc-patches@gcc.gnu.org

Hello world,

here is a correct version of a fix for PR 44693.  This contains the
necessary special case for SPREAD (where dim can be one larger than the
rank of the array), an expanded test case and a correction to an old
test case.

I think this is finally correct.

Regression-tested, no new regressions.

OK for trunk?

	Thomas

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.


Index: testsuite/gfortran.dg/minmaxloc_4.f90
===================================================================
--- testsuite/gfortran.dg/minmaxloc_4.f90	(Revision 161784)
+++ testsuite/gfortran.dg/minmaxloc_4.f90	(Arbeitskopie)
@@ -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 @@
   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
Index: fortran/check.c
===================================================================
--- fortran/check.c	(Revision 161784)
+++ fortran/check.c	(Arbeitskopie)
@@ -473,12 +473,15 @@
   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);