This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Fix PR fortran/44693, take 2


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);
! { 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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]