[multiple changes]

2009-07-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/34670
	PR libfortran/36874
	* Makefile.am:  Add bounds.c
	* libgfortran.h (bounds_equal_extents):  Add prototype.
	(bounds_iforeach_return):  Likewise.
	(bounds_ifunction_return):  Likewise.
	(bounds_reduced_extents):  Likewise.
	* runtime/bounds.c:  New file.
	(bounds_iforeach_return):  New function; correct typo in
	error message.
	(bounds_ifunction_return):  New function.
	(bounds_equal_extents):  New function.
	(bounds_reduced_extents):  Likewise.
	* intrinsics/cshift0.c (cshift0):  Use new functions
	for bounds checking.
	* intrinsics/eoshift0.c (eoshift0):  Likewise.
	* intrinsics/eoshift2.c (eoshift2):  Likewise.
	* m4/iforeach.m4:  Likewise.
	* m4/eoshift1.m4:  Likewise.
	* m4/eoshift3.m4:  Likewise.
	* m4/cshift1.m4:  Likewise.
	* m4/ifunction.m4:  Likewise.
	* Makefile.in:  Regenerated.
	* generated/cshift1_16.c: Regenerated.
	* generated/cshift1_4.c: Regenerated.
	* generated/cshift1_8.c: Regenerated.
	* generated/eoshift1_16.c: Regenerated.
	* generated/eoshift1_4.c: Regenerated.
	* generated/eoshift1_8.c: Regenerated.
	* generated/eoshift3_16.c: Regenerated.
	* generated/eoshift3_4.c: Regenerated.
	* generated/eoshift3_8.c: Regenerated.
	* generated/maxloc0_16_i1.c: Regenerated.
	* generated/maxloc0_16_i16.c: Regenerated.
	* generated/maxloc0_16_i2.c: Regenerated.
	* generated/maxloc0_16_i4.c: Regenerated.
	* generated/maxloc0_16_i8.c: Regenerated.
	* generated/maxloc0_16_r10.c: Regenerated.
	* generated/maxloc0_16_r16.c: Regenerated.
	* generated/maxloc0_16_r4.c: Regenerated.
	* generated/maxloc0_16_r8.c: Regenerated.
	* generated/maxloc0_4_i1.c: Regenerated.
	* generated/maxloc0_4_i16.c: Regenerated.
	* generated/maxloc0_4_i2.c: Regenerated.
	* generated/maxloc0_4_i4.c: Regenerated.
	* generated/maxloc0_4_i8.c: Regenerated.
	* generated/maxloc0_4_r10.c: Regenerated.
	* generated/maxloc0_4_r16.c: Regenerated.
	* generated/maxloc0_4_r4.c: Regenerated.
	* generated/maxloc0_4_r8.c: Regenerated.
	* generated/maxloc0_8_i1.c: Regenerated.
	* generated/maxloc0_8_i16.c: Regenerated.
	* generated/maxloc0_8_i2.c: Regenerated.
	* generated/maxloc0_8_i4.c: Regenerated.
	* generated/maxloc0_8_i8.c: Regenerated.
	* generated/maxloc0_8_r10.c: Regenerated.
	* generated/maxloc0_8_r16.c: Regenerated.
	* generated/maxloc0_8_r4.c: Regenerated.
	* generated/maxloc0_8_r8.c: Regenerated.
	* generated/maxloc1_16_i1.c: Regenerated.
	* generated/maxloc1_16_i16.c: Regenerated.
	* generated/maxloc1_16_i2.c: Regenerated.
	* generated/maxloc1_16_i4.c: Regenerated.
	* generated/maxloc1_16_i8.c: Regenerated.
	* generated/maxloc1_16_r10.c: Regenerated.
	* generated/maxloc1_16_r16.c: Regenerated.
	* generated/maxloc1_16_r4.c: Regenerated.
	* generated/maxloc1_16_r8.c: Regenerated.
	* generated/maxloc1_4_i1.c: Regenerated.
	* generated/maxloc1_4_i16.c: Regenerated.
	* generated/maxloc1_4_i2.c: Regenerated.
	* generated/maxloc1_4_i4.c: Regenerated.
	* generated/maxloc1_4_i8.c: Regenerated.
	* generated/maxloc1_4_r10.c: Regenerated.
	* generated/maxloc1_4_r16.c: Regenerated.
	* generated/maxloc1_4_r4.c: Regenerated.
	* generated/maxloc1_4_r8.c: Regenerated.
	* generated/maxloc1_8_i1.c: Regenerated.
	* generated/maxloc1_8_i16.c: Regenerated.
	* generated/maxloc1_8_i2.c: Regenerated.
	* generated/maxloc1_8_i4.c: Regenerated.
	* generated/maxloc1_8_i8.c: Regenerated.
	* generated/maxloc1_8_r10.c: Regenerated.
	* generated/maxloc1_8_r16.c: Regenerated.
	* generated/maxloc1_8_r4.c: Regenerated.
	* generated/maxloc1_8_r8.c: Regenerated.
	* generated/maxval_i1.c: Regenerated.
	* generated/maxval_i16.c: Regenerated.
	* generated/maxval_i2.c: Regenerated.
	* generated/maxval_i4.c: Regenerated.
	* generated/maxval_i8.c: Regenerated.
	* generated/maxval_r10.c: Regenerated.
	* generated/maxval_r16.c: Regenerated.
	* generated/maxval_r4.c: Regenerated.
	* generated/maxval_r8.c: Regenerated.
	* generated/minloc0_16_i1.c: Regenerated.
	* generated/minloc0_16_i16.c: Regenerated.
	* generated/minloc0_16_i2.c: Regenerated.
	* generated/minloc0_16_i4.c: Regenerated.
	* generated/minloc0_16_i8.c: Regenerated.
	* generated/minloc0_16_r10.c: Regenerated.
	* generated/minloc0_16_r16.c: Regenerated.
	* generated/minloc0_16_r4.c: Regenerated.
	* generated/minloc0_16_r8.c: Regenerated.
	* generated/minloc0_4_i1.c: Regenerated.
	* generated/minloc0_4_i16.c: Regenerated.
	* generated/minloc0_4_i2.c: Regenerated.
	* generated/minloc0_4_i4.c: Regenerated.
	* generated/minloc0_4_i8.c: Regenerated.
	* generated/minloc0_4_r10.c: Regenerated.
	* generated/minloc0_4_r16.c: Regenerated.
	* generated/minloc0_4_r4.c: Regenerated.
	* generated/minloc0_4_r8.c: Regenerated.
	* generated/minloc0_8_i1.c: Regenerated.
	* generated/minloc0_8_i16.c: Regenerated.
	* generated/minloc0_8_i2.c: Regenerated.
	* generated/minloc0_8_i4.c: Regenerated.
	* generated/minloc0_8_i8.c: Regenerated.
	* generated/minloc0_8_r10.c: Regenerated.
	* generated/minloc0_8_r16.c: Regenerated.
	* generated/minloc0_8_r4.c: Regenerated.
	* generated/minloc0_8_r8.c: Regenerated.
	* generated/minloc1_16_i1.c: Regenerated.
	* generated/minloc1_16_i16.c: Regenerated.
	* generated/minloc1_16_i2.c: Regenerated.
	* generated/minloc1_16_i4.c: Regenerated.
	* generated/minloc1_16_i8.c: Regenerated.
	* generated/minloc1_16_r10.c: Regenerated.
	* generated/minloc1_16_r16.c: Regenerated.
	* generated/minloc1_16_r4.c: Regenerated.
	* generated/minloc1_16_r8.c: Regenerated.
	* generated/minloc1_4_i1.c: Regenerated.
	* generated/minloc1_4_i16.c: Regenerated.
	* generated/minloc1_4_i2.c: Regenerated.
	* generated/minloc1_4_i4.c: Regenerated.
	* generated/minloc1_4_i8.c: Regenerated.
	* generated/minloc1_4_r10.c: Regenerated.
	* generated/minloc1_4_r16.c: Regenerated.
	* generated/minloc1_4_r4.c: Regenerated.
	* generated/minloc1_4_r8.c: Regenerated.
	* generated/minloc1_8_i1.c: Regenerated.
	* generated/minloc1_8_i16.c: Regenerated.
	* generated/minloc1_8_i2.c: Regenerated.
	* generated/minloc1_8_i4.c: Regenerated.
	* generated/minloc1_8_i8.c: Regenerated.
	* generated/minloc1_8_r10.c: Regenerated.
	* generated/minloc1_8_r16.c: Regenerated.
	* generated/minloc1_8_r4.c: Regenerated.
	* generated/minloc1_8_r8.c: Regenerated.
	* generated/minval_i1.c: Regenerated.
	* generated/minval_i16.c: Regenerated.
	* generated/minval_i2.c: Regenerated.
	* generated/minval_i4.c: Regenerated.
	* generated/minval_i8.c: Regenerated.
	* generated/minval_r10.c: Regenerated.
	* generated/minval_r16.c: Regenerated.
	* generated/minval_r4.c: Regenerated.
	* generated/minval_r8.c: Regenerated.
	* generated/product_c10.c: Regenerated.
	* generated/product_c16.c: Regenerated.
	* generated/product_c4.c: Regenerated.
	* generated/product_c8.c: Regenerated.
	* generated/product_i1.c: Regenerated.
	* generated/product_i16.c: Regenerated.
	* generated/product_i2.c: Regenerated.
	* generated/product_i4.c: Regenerated.
	* generated/product_i8.c: Regenerated.
	* generated/product_r10.c: Regenerated.
	* generated/product_r16.c: Regenerated.
	* generated/product_r4.c: Regenerated.
	* generated/product_r8.c: Regenerated.
	* generated/sum_c10.c: Regenerated.
	* generated/sum_c16.c: Regenerated.
	* generated/sum_c4.c: Regenerated.
	* generated/sum_c8.c: Regenerated.
	* generated/sum_i1.c: Regenerated.
	* generated/sum_i16.c: Regenerated.
	* generated/sum_i2.c: Regenerated.
	* generated/sum_i4.c: Regenerated.
	* generated/sum_i8.c: Regenerated.
	* generated/sum_r10.c: Regenerated.
	* generated/sum_r16.c: Regenerated.
	* generated/sum_r4.c: Regenerated.
	* generated/sum_r8.c: Regenerated.

2009-07-19   Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/34670
	PR libfortran/36874
	* gfortran.dg/cshift_bounds_1.f90:  New test.
	* gfortran.dg/cshift_bounds_2.f90:  New test.
	* gfortran.dg/cshift_bounds_3.f90:  New test.
	* gfortran.dg/cshift_bounds_4.f90:  New test.
	* gfortran.dg/eoshift_bounds_1.f90:  New test.
	* gfortran.dg/maxloc_bounds_4.f90:  Correct typo in error message.
	* gfortran.dg/maxloc_bounds_5.f90:  Correct typo in error message.
	* gfortran.dg/maxloc_bounds_7.f90:  Correct typo in error message.

From-SVN: r149792

1 files changed, 199 insertions, 0 deletions

diff --git a/libgfortran/runtime/bounds.c b/libgfortran/runtime/bounds.c
new file mode 100644
index 0000000..8a7affd
--- /dev/null
+++ b/libgfortran/runtime/bounds.c
@@ -0,0 +1,199 @@
+/* Copyright (C) 2009
+   Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <assert.h>
+
+/* Auxiliary functions for bounds checking, mostly to reduce library size.  */
+
+/* Bounds checking for the return values of the iforeach functions (such
+   as maxloc and minloc).  The extent of ret_array must
+   must match the rank of array.  */
+
+void
+bounds_iforeach_return (array_t *retarray, array_t *array, const char *name)
+{
+  index_type rank;
+  index_type ret_rank;
+  index_type ret_extent;
+
+  ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+
+  if (ret_rank != 1)
+    runtime_error ("Incorrect rank of return array in %s intrinsic:"
+		   "is %ld, should be 1", name, (long int) ret_rank);
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
+  if (ret_extent != rank)
+    runtime_error ("Incorrect extent in return value of"
+		   " %s intrinsic: is %ld, should be %ld",
+		   name, (long int) ret_extent, (long int) rank);
+
+}
+
+/* Check the return of functions generated from ifunction.m4.
+   We check the array descriptor "a" against the extents precomputed
+   from ifunction.m4, and complain about the argument a_name in the
+   intrinsic function. */
+
+void
+bounds_ifunction_return (array_t * a, const index_type * extent,
+			 const char * a_name, const char * intrinsic)
+{
+  int empty;
+  int n;
+  int rank;
+  index_type a_size;
+
+  rank = GFC_DESCRIPTOR_RANK (a);
+  a_size = size0 (a);
+
+  empty = 0;
+  for (n = 0; n < rank; n++)
+    {
+      if (extent[n] == 0)
+	empty = 1;
+    }
+  if (empty)
+    {
+      if (a_size != 0)
+	runtime_error ("Incorrect size in %s of %s"
+		       " intrinsic: should be zero-sized",
+		       a_name, intrinsic);
+    }
+  else
+    {
+      if (a_size == 0)
+	runtime_error ("Incorrect size of %s in %s"
+		       " intrinsic: should not be zero-sized",
+		       a_name, intrinsic);
+
+      for (n = 0; n < rank; n++)
+	{
+	  index_type a_extent;
+	  a_extent = GFC_DESCRIPTOR_EXTENT(a, n);
+	  if (a_extent != extent[n])
+	    runtime_error("Incorrect extent in %s of %s"
+			  " intrinsic in dimension %ld: is %ld,"
+			  " should be %ld", a_name, intrinsic, (long int) n + 1,
+			  (long int) a_extent, (long int) extent[n]);
+
+	}
+    }
+}
+
+/* Check that two arrays have equal extents, or are both zero-sized.  Abort
+   with a runtime error if this is not the case.  Complain that a has the
+   wrong size.  */
+
+void
+bounds_equal_extents (array_t *a, array_t *b, const char *a_name,
+		      const char *intrinsic)
+{
+  index_type a_size, b_size, n;
+
+  assert (GFC_DESCRIPTOR_RANK(a) == GFC_DESCRIPTOR_RANK(b));
+
+  a_size = size0 (a);
+  b_size = size0 (b);
+
+  if (b_size == 0)
+    {
+      if (a_size != 0)
+	runtime_error ("Incorrect size of %s in %s"
+		       " intrinsic: should be zero-sized",
+		       a_name, intrinsic);
+    }
+  else
+    {
+      if (a_size == 0) 
+	runtime_error ("Incorrect size of %s of %s"
+		       " intrinsic: Should not be zero-sized",
+		       a_name, intrinsic);
+
+      for (n = 0; n < GFC_DESCRIPTOR_RANK (b); n++)
+	{
+	  index_type a_extent, b_extent;
+	  
+	  a_extent = GFC_DESCRIPTOR_EXTENT(a, n);
+	  b_extent = GFC_DESCRIPTOR_EXTENT(b, n);
+	  if (a_extent != b_extent)
+	    runtime_error("Incorrect extent in %s of %s"
+			  " intrinsic in dimension %ld: is %ld,"
+			  " should be %ld", a_name, intrinsic, (long int) n + 1,
+			  (long int) a_extent, (long int) b_extent);
+	}
+    }
+}
+
+/* Check that the extents of a and b agree, except that a has a missing
+   dimension in argument which.  Complain about a if anything is wrong.  */
+
+void
+bounds_reduced_extents (array_t *a, array_t *b, int which, const char *a_name,
+		      const char *intrinsic)
+{
+
+  index_type i, n, a_size, b_size;
+
+  assert (GFC_DESCRIPTOR_RANK(a) == GFC_DESCRIPTOR_RANK(b) - 1);
+
+  a_size = size0 (a);
+  b_size = size0 (b);
+
+  if (b_size == 0)
+    {
+      if (a_size != 0)
+	runtime_error ("Incorrect size in %s of %s"
+		       " intrinsic: should not be zero-sized",
+		       a_name, intrinsic);
+    }
+  else
+    {
+      if (a_size == 0) 
+	runtime_error ("Incorrect size of %s of %s"
+		       " intrinsic: should be zero-sized",
+		       a_name, intrinsic);
+
+      i = 0;
+      for (n = 0; n < GFC_DESCRIPTOR_RANK (b); n++)
+	{
+	  index_type a_extent, b_extent;
+
+	  if (n != which)
+	    {
+	      a_extent = GFC_DESCRIPTOR_EXTENT(a, i);
+	      b_extent = GFC_DESCRIPTOR_EXTENT(b, n);
+	      if (a_extent != b_extent)
+		runtime_error("Incorrect extent in %s of %s"
+			      " intrinsic in dimension %ld: is %ld,"
+			      " should be %ld", a_name, intrinsic, (long int) i + 1,
+			      (long int) a_extent, (long int) b_extent);
+	      i++;
+	    }
+	}
+    }
+}