This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran 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]

[patch, Fortran] Add rank checks for EOSHIFT and CSHIFT


This adds the missing rank checks for EOSHIFT and CSHIFT, which I mentioned in
http://gcc.gnu.org/ml/fortran/2008-07/msg00116.html

(I believe the run-time errors of NAG are wrong as is the c(1,:) error
of ifort.)

Build and make check-gfortran on x86-64-linux.
OK for the trunk?

Tobias

PS: Thomas, I will review your patch tomorrow, bootstapping your patch
in the maintainer-mode takes too long.
2008-07-18  Tobias Burnus  <burnus@net-b.de>

	* check.c (gfc_check_cshift,gfc_check_eoshift): Add rank
	checks for cshift's shift and eoshift's shift and boundary args.

2008-07-18  Tobias Burnus  <burnus@net-b.de>

	* gfortran.dg/eoshift_3.f90: New.

Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c	(Revision 137967)
+++ gcc/fortran/check.c	(Arbeitskopie)
@@ -876,9 +876,11 @@ gfc_check_cshift (gfc_expr *array, gfc_e
       if (scalar_check (shift, 1) == FAILURE)
 	return FAILURE;
     }
-  else
+  else if (shift->rank != array->rank - 1 && shift->rank != 0)
     {
-      /* TODO: more requirements on shift parameter.  */
+      gfc_error ("SHIFT argument at %L of EOSHIFT must have rank %d or be a "
+		 "scalar", &shift->where, array->rank - 1);
+      return FAILURE;
     }
 
   if (dim_check (dim, 2, true) == FAILURE)
@@ -1037,9 +1039,11 @@ gfc_check_eoshift (gfc_expr *array, gfc_
       if (scalar_check (shift, 2) == FAILURE)
 	return FAILURE;
     }
-  else
+  else if (shift->rank != array->rank - 1 && shift->rank != 0)
     {
-      /* TODO: more weird restrictions on shift.  */
+      gfc_error ("SHIFT argument at %L of EOSHIFT must have rank %d or be a "
+		 "scalar", &shift->where, array->rank - 1);
+      return FAILURE;
     }
 
   if (boundary != NULL)
@@ -1047,7 +1051,17 @@ gfc_check_eoshift (gfc_expr *array, gfc_
       if (same_type_check (array, 0, boundary, 2) == FAILURE)
 	return FAILURE;
 
-      /* TODO: more restrictions on boundary.  */
+      if (array->rank == 1)
+	{
+	  if (scalar_check (boundary, 2) == FAILURE)
+	    return FAILURE;
+	}
+      else if (boundary->rank != array->rank - 1 && boundary->rank != 0)
+	{
+	  gfc_error ("BOUNDARY argument at %L of EOSHIFT must have rank %d or be "
+		     "a scalar", &boundary->where, array->rank - 1);
+	  return FAILURE;
+	}
     }
 
   if (dim_check (dim, 4, true) == FAILURE)
Index: gcc/testsuite/gfortran.dg/eoshift_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/eoshift_3.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/eoshift_3.f90	(Revision 0)
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! Some CSHIFT and EOSHIFT tests
+!
+program main
+  real, dimension(1)   :: a1, b1, c1
+  real, dimension(1,1) :: a2, b2, c2
+  a1 = 0
+  a2 = 0
+  c1 = 0
+  a2 = 0
+
+  b1 = cshift (a1,1)
+  b1 = cshift (a1,(/1/)) ! { dg-error "must be a scalar" }
+  b1 = eoshift (a1,1)
+  b2 = eoshift (a1,c1(1)) ! { dg-error "must be INTEGER" }
+  b1 = eoshift (a1,(/1/)) ! { dg-error "must be a scalar" }
+  b1 = eoshift (a1,1,boundary=c1) ! { dg-error "must be a scalar" }
+  b1 = eoshift (a1,(/1/), boundary=c2) ! { dg-error "must be a scalar" }
+
+  b2 = cshift (a2,1)
+  b2 = cshift (a2,(/1/))
+  b2 = cshift (a2,reshape([1],[1,1])) ! { dg-error "have rank 1 or be a scalar" }
+  b2 = eoshift (a2,1)
+  b2 = eoshift (a2,c1) ! { dg-error "must be INTEGER" }
+  b2 = eoshift (a2,(/1/))
+  b2 = eoshift (a2,reshape([1],[1,1]), boundary=c1) ! { dg-error "have rank 1 or be a scalar" }
+  b2 = eoshift (a2,1,boundary=c2(:,:)) ! { dg-error "have rank 1 or be a scalar" }
+  b2 = eoshift (a2,(/1/), boundary=c2(:,:)) ! { dg-error "have rank 1 or be a scalar" }
+end program main

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