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]

Re: [patch, libfortran] Bounds checking for (c|eo)shift, bounds checking library functions


On Thu, 2009-07-16 at 22:59 +0200, Tobias Burnus wrote:
> Thomas Koenig schrieb:
> > this patch implements bounds checking for the cshift and eoshift library
> > functions.
> > Regression-tested on i686-pc-linux-gnu.  OK for trunk?
> >   
> 
> +extern void bounds_equal_extents (array_t *, array_t *, const char *,
> +				  const char *);
> +internal_proto(bounds_equal_extents);
> +
> +void bounds_reduced_extents (array_t *, array_t *, int, const char *,
> +			     const char *intrinsic);
> +internal_proto(bounds_reduced_extents);
> 
> 
> Is there a reason that the first one is extern and the second one is not?

Seems we mostly use extern (there really isn't much point either way).
I'll add it.

> 
> 
> +This file is part of the GNU Fortran 95 runtime library (libgfortran).
> 
> Remove the "95".

$ grep -l "Fortran 95" */* | wc -l
626
$ grep -l "Fortran runtime" */* | wc -l
16

I'll do so, but then it's definitely time for a cleanup patch for all
the other files :-)

> +/* Bounds checking for the return values of the iforeach functions.  */
> 
> and
> 
> +/* Check the return of functions generated from ifunction.m4.  */
> 
> 
> Can you provide a short comment what the function actually does?

Addressed.


> Start with a capital letter. I somehow have parsing problems with ", is
> %ld" [contrary to another message below - "...: is %ld, should be %ld" -
> maybe due to the colon?) Thus I am tempted to insert either a "but" or
> an "it".

Changed to something more legible.

> 
> +    runtime_error ("Incorrect extent in return value of"
> +		   " %s intrnisic: is %ld, should be %ld",
> 
> 
> Typo: intrinsic

Fixed (this was actually a pre-existing error).

> 
> @@ -61,6 +62,8 @@ eoshift0 (gfc_array_char * ret, const gf
>    soffset = 0;
>    roffset = 0;
>  
> +  arraysize = size0 ((array_t *) array);
> +
>    if (ret->data == NULL)
>      {
>        int i;
> @@ -83,13 +86,22 @@ eoshift0 (gfc_array_char * ret, const gf
>  	  GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
>  
>          }
> +
> +      if (arraysize > 0)
> +	ret->data = internal_malloc_size (size * arraysize);
> +      else
> +	ret->data = internal_malloc_size (1);
> +
>      }
> 
> 
> 
> Sorry, I do not understand what you are doing here.  For completeness,
> the line after "int i" is:
>       ret->data = internal_malloc_size (size * size0 ((array_t *)array));

Ah, I'd actually overlooked that line (same thing with eoshift2.c).

> Shouldn't you move the "if(arraysize > 0) block up to that place and
> replace the line by the if-else block?

I've left it down there, to make the code more similar to the code I'd
added in other places.


> Otherwise the patch looks OK.

Thanks a lot for the thorough review!

Here's what I committed (rev. 149792):

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.


Index: libgfortran/Makefile.am
===================================================================
--- libgfortran/Makefile.am	(revision 149154)
+++ libgfortran/Makefile.am	(working copy)
@@ -122,6 +122,7 @@ runtime/in_unpack_generic.c
 
 gfor_src= \
 runtime/backtrace.c \
+runtime/bounds.c \
 runtime/compile_options.c \
 runtime/convert_char.c \
 runtime/environ.c \
Index: libgfortran/libgfortran.h
===================================================================
--- libgfortran/libgfortran.h	(revision 149154)
+++ libgfortran/libgfortran.h	(working copy)
@@ -1242,6 +1242,23 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DI
 extern index_type size0 (const array_t * array); 
 iexport_proto(size0);
 
+/* bounds.c */
+
+extern void bounds_equal_extents (array_t *, array_t *, const char *,
+				  const char *);
+internal_proto(bounds_equal_extents);
+
+extern void bounds_reduced_extents (array_t *, array_t *, int, const char *,
+			     const char *intrinsic);
+internal_proto(bounds_reduced_extents);
+
+extern void bounds_iforeach_return (array_t *, array_t *, const char *);
+internal_proto(bounds_iforeach_return);
+
+extern void bounds_ifunction_return (array_t *, const index_type *,
+				     const char *, const char *);
+internal_proto(bounds_ifunction_return);
+
 /* Internal auxiliary functions for cshift */
 
 void cshift0_i1 (gfc_array_i1 *, const gfc_array_i1 *, ssize_t, int);
Index: libgfortran/runtime/bounds.c
===================================================================
--- libgfortran/runtime/bounds.c	(revision 0)
+++ libgfortran/runtime/bounds.c	(revision 0)
@@ -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++;
+	    }
+	}
+    }
+}
Index: libgfortran/intrinsics/cshift0.c
===================================================================
--- libgfortran/intrinsics/cshift0.c	(revision 149154)
+++ libgfortran/intrinsics/cshift0.c	(working copy)
@@ -87,14 +87,17 @@ cshift0 (gfc_array_char * ret, const gfc
       if (arraysize > 0)
 	ret->data = internal_malloc_size (size * arraysize);
       else
-	{
-	  ret->data = internal_malloc_size (1);
-	  return;
-	}
+	ret->data = internal_malloc_size (1);
     }
-  
+  else if (unlikely (compile_options.bounds_check))
+    {
+      bounds_equal_extents ((array_t *) ret, (array_t *) array,
+				 "return value", "CSHIFT");
+    }
+
   if (arraysize == 0)
     return;
+
   type_size = GFC_DTYPE_TYPE_SIZE (array);
 
   switch(type_size)
Index: libgfortran/intrinsics/eoshift0.c
===================================================================
--- libgfortran/intrinsics/eoshift0.c	(revision 149154)
+++ libgfortran/intrinsics/eoshift0.c	(working copy)
@@ -54,6 +54,7 @@ eoshift0 (gfc_array_char * ret, const gf
   index_type dim;
   index_type len;
   index_type n;
+  index_type arraysize;
 
   /* The compiler cannot figure out that these are set, initialize
      them to avoid warnings.  */
@@ -61,11 +62,12 @@ eoshift0 (gfc_array_char * ret, const gf
   soffset = 0;
   roffset = 0;
 
+  arraysize = size0 ((array_t *) array);
+
   if (ret->data == NULL)
     {
       int i;
 
-      ret->data = internal_malloc_size (size * size0 ((array_t *)array));
       ret->offset = 0;
       ret->dtype = array->dtype;
       for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
@@ -83,13 +85,22 @@ eoshift0 (gfc_array_char * ret, const gf
 	  GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
 
         }
+
+      if (arraysize > 0)
+	ret->data = internal_malloc_size (size * arraysize);
+      else
+	ret->data = internal_malloc_size (1);
+
     }
-  else
+  else if (unlikely (compile_options.bounds_check))
     {
-      if (size0 ((array_t *) ret) == 0)
-	return;
+      bounds_equal_extents ((array_t *) ret, (array_t *) array,
+				 "return value", "EOSHIFT");
     }
 
+  if (arraysize == 0)
+    return;
+
   which = which - 1;
 
   extent[0] = 1;
Index: libgfortran/intrinsics/eoshift2.c
===================================================================
--- libgfortran/intrinsics/eoshift2.c	(revision 149154)
+++ libgfortran/intrinsics/eoshift2.c	(working copy)
@@ -75,7 +75,6 @@ eoshift2 (gfc_array_char *ret, const gfc
     {
       int i;
 
-      ret->data = internal_malloc_size (size * arraysize);
       ret->offset = 0;
       ret->dtype = array->dtype;
       for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
@@ -92,15 +91,20 @@ eoshift2 (gfc_array_char *ret, const gfc
 
 	  GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
 
+	  if (arraysize > 0)
+	    ret->data = internal_malloc_size (size * arraysize);
+	  else
+	    ret->data = internal_malloc_size (1);
+
         }
     }
-  else
+  else if (unlikely (compile_options.bounds_check))
     {
-      if (size0 ((array_t *) ret) == 0)
-	return;
+      bounds_equal_extents ((array_t *) ret, (array_t *) array,
+				 "return value", "EOSHIFT");
     }
 
-  if (arraysize == 0 && filler == NULL)
+  if (arraysize == 0)
     return;
 
   which = which - 1;
Index: gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90	(revision 149154)
+++ gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90	(working copy)
@@ -1,6 +1,6 @@
 ! { dg-do run }
 ! { dg-options "-fbounds-check" }
-! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" }
+! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
 module tst
 contains
   subroutine foo(res)
@@ -18,5 +18,5 @@ program main
   integer :: res(3)
   call foo(res)
 end program main
-! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" }
+! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
 ! { dg-final { cleanup-modules "tst" } }
Index: gcc/testsuite/gfortran.dg/eoshift_bounds_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/eoshift_bounds_1.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/eoshift_bounds_1.f90	(revision 0)
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect size in SHIFT argument of EOSHIFT intrinsic: should not be zero-sized" }
+program main
+  real, dimension(1,0) :: a, b, c
+  integer :: sp(3), i
+  a = 4.0
+  sp = 1
+  i = 1
+  b = eoshift (a,sp(1:i)) ! Invalid
+end program main
+! { dg-output "Fortran runtime error: Incorrect size in SHIFT argument of EOSHIFT intrinsic: should not be zero-sized" }
Index: gcc/testsuite/gfortran.dg/cshift_bounds_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/cshift_bounds_2.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/cshift_bounds_2.f90	(revision 0)
@@ -0,0 +1,11 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect extent in return value of CSHIFT intrinsic in dimension 2: is 3, should be 2" }
+program main
+  integer, dimension(:,:), allocatable :: a, b
+  allocate (a(2,2))
+  allocate (b(2,3))
+  a = 1
+  b = cshift(a,1)
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return value of CSHIFT intrinsic in dimension 2: is 3, should be 2" }
Index: gcc/testsuite/gfortran.dg/cshift_bounds_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/cshift_bounds_4.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/cshift_bounds_4.f90	(revision 0)
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-shouldfail "Incorrect extent in SHIFT argument of CSHIFT intrinsic in dimension 1: is 3, should be 2" }
+! { dg-options "-fbounds-check" }
+program main
+  integer, dimension(:,:), allocatable :: a, b
+  integer, dimension(:), allocatable :: sh
+  allocate (a(2,2))
+  allocate (b(2,2))
+  allocate (sh(3))
+  a = 1
+  b = cshift(a,sh)
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in SHIFT argument of CSHIFT intrinsic in dimension 1: is 3, should be 2" }
Index: gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90	(revision 149154)
+++ gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90	(working copy)
@@ -1,6 +1,6 @@
 ! { dg-do run }
 ! { dg-options "-fbounds-check" }
-! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" }
+! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
 module tst
 contains
   subroutine foo(res)
@@ -18,6 +18,6 @@ program main
   integer :: res(3)
   call foo(res)
 end program main
-! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" }
+! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
 ! { dg-final { cleanup-modules "tst" } }
 
Index: gcc/testsuite/gfortran.dg/cshift_bounds_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/cshift_bounds_1.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/cshift_bounds_1.f90	(revision 0)
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! Check that empty arrays are handled correctly in
+! cshift and eoshift
+program main
+  character(len=50) :: line
+  character(len=3), dimension(2,2) :: a, b
+  integer :: n1, n2
+  line = '-1-2'
+  read (line,'(2I2)') n1, n2
+  call foo(a, b, n1, n2)
+  a = 'abc'
+  write (line,'(4A)') eoshift(a, 3)
+  write (line,'(4A)') cshift(a, 3)
+  write (line,'(4A)') cshift(a(:,1:n1), 3)
+  write (line,'(4A)') eoshift(a(1:n2,:), 3)
+end program main
+
+subroutine foo(a, b, n1, n2)
+  character(len=3), dimension(2, n1) :: a
+  character(len=3), dimension(n2, 2) :: b
+  a = cshift(b,1)
+  a = eoshift(b,1)
+end subroutine foo
Index: gcc/testsuite/gfortran.dg/cshift_bounds_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/cshift_bounds_3.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/cshift_bounds_3.f90	(revision 0)
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect size in SHIFT argument of CSHIFT intrinsic: should not be zero-sized" }
+program main
+  real, dimension(1,0) :: a, b, c
+  integer :: sp(3), i
+  a = 4.0
+  sp = 1
+  i = 1
+  b = cshift (a,sp(1:i)) ! Invalid
+end program main
+! { dg-output "Fortran runtime error: Incorrect size in SHIFT argument of CSHIFT intrinsic: should not be zero-sized" }
Index: gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90	(revision 149154)
+++ gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90	(working copy)
@@ -1,6 +1,6 @@
 ! { dg-do run }
 ! { dg-options "-fbounds-check" }
-! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" }
+! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
 module tst
 contains
   subroutine foo(res)
@@ -18,5 +18,5 @@ program main
   integer :: res(3)
   call foo(res)
 end program main
-! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" }
+! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
 ! { dg-final { cleanup-modules "tst" } }

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