This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[patch, libfortran] Fix PR 36773
- From: Thomas Koenig <tkoenig at netcologne dot de>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Fri, 18 Jul 2008 00:22:17 +0200
- Subject: [patch, libfortran] Fix PR 36773
Hello world,
the attached is regtested on i686-pc-linux-gnu. Checking the
array argument for eoshift doesn't work because you can have an
empty array argument and non-empty return argument; the values
will just be filled with zero or spaces or whatever.
OK for trunk?
Thomas
2008-07-17 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/36773
* intrinsics/cshift0.c (cshift0): Return early if size of array
is zero.
* intrinsics/eoshift0.c (eoshift0): Return early if size of
return array is zero.
* intrinsics/eoshift2.c (eoshift2): Likewise.
* m4/eoshift1.m4 (eoshift1): Return early if size of array
is zero.
* m4/eoshift3.m4 (eoshift3): Likewise.
* m4/eoshift2.m4 (eoshift2): Return early if size of return
array is zero.
* m4/eoshift4.m4 (eoshift2): Return early if size of return
array is zero.
* 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.
2008-07-17 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/36773
* gfortran.dg/zero_sized_5.f90: New test case.
Index: intrinsics/cshift0.c
===================================================================
--- intrinsics/cshift0.c (revision 137216)
+++ intrinsics/cshift0.c (working copy)
@@ -97,10 +97,43 @@ cshift0 (gfc_array_char * ret, const gfc
index_type len;
index_type n;
int whichloop;
+ index_type arraysize;
if (which < 1 || which > GFC_DESCRIPTOR_RANK (array))
runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'");
+ arraysize = size0 ((array_t *) array);
+
+ if (ret->data == NULL)
+ {
+ int i;
+
+ ret->offset = 0;
+ ret->dtype = array->dtype;
+ for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
+ {
+ ret->dim[i].lbound = 0;
+ ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+
+ if (i == 0)
+ ret->dim[i].stride = 1;
+ else
+ ret->dim[i].stride = (ret->dim[i-1].ubound + 1)
+ * ret->dim[i-1].stride;
+ }
+
+ if (arraysize > 0)
+ ret->data = internal_malloc_size (size * arraysize);
+ else
+ {
+ ret->data = internal_malloc_size (1);
+ return;
+ }
+ }
+
+ if (arraysize == 0)
+ return;
+
which = which - 1;
sstride[0] = 0;
rstride[0] = 0;
@@ -142,34 +175,6 @@ cshift0 (gfc_array_char * ret, const gfc
soffset = size;
len = 0;
- if (ret->data == NULL)
- {
- int i;
- index_type arraysize = size0 ((array_t *)array);
-
- ret->offset = 0;
- ret->dtype = array->dtype;
- for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
- {
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
-
- if (i == 0)
- ret->dim[i].stride = 1;
- else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1)
- * ret->dim[i-1].stride;
- }
-
- if (arraysize > 0)
- ret->data = internal_malloc_size (size * arraysize);
- else
- {
- ret->data = internal_malloc_size (1);
- return;
- }
- }
-
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
{
if (dim == which)
Index: intrinsics/eoshift0.c
===================================================================
--- intrinsics/eoshift0.c (revision 137216)
+++ intrinsics/eoshift0.c (working copy)
@@ -84,6 +84,11 @@ eoshift0 (gfc_array_char * ret, const gf
ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
}
}
+ else
+ {
+ if (size0 ((array_t *) ret) == 0)
+ return;
+ }
which = which - 1;
Index: intrinsics/eoshift2.c
===================================================================
--- intrinsics/eoshift2.c (revision 137216)
+++ intrinsics/eoshift2.c (working copy)
@@ -63,6 +63,7 @@ eoshift2 (gfc_array_char *ret, const gfc
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. */
@@ -70,11 +71,13 @@ eoshift2 (gfc_array_char *ret, const gfc
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->data = internal_malloc_size (size * arraysize);
ret->offset = 0;
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
@@ -88,6 +91,14 @@ eoshift2 (gfc_array_char *ret, const gfc
ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
}
}
+ else
+ {
+ if (size0 ((array_t *) ret) == 0)
+ return;
+ }
+
+ if (arraysize == 0 && filler == NULL)
+ return;
which = which - 1;
Index: m4/eoshift1.m4
===================================================================
--- m4/eoshift1.m4 (revision 137216)
+++ m4/eoshift1.m4 (working copy)
@@ -103,6 +103,11 @@ eoshift1 (gfc_array_char * const restric
ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
}
}
+ else
+ {
+ if (size0 ((array_t *) ret) == 0)
+ return;
+ }
n = 0;
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
Index: m4/eoshift3.m4
===================================================================
--- m4/eoshift3.m4 (revision 137216)
+++ m4/eoshift3.m4 (working copy)
@@ -104,6 +104,11 @@ eoshift3 (gfc_array_char * const restric
ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
}
}
+ else
+ {
+ if (size0 ((array_t *) ret) == 0)
+ return;
+ }
extent[0] = 1;
Index: m4/cshift1.m4
===================================================================
--- m4/cshift1.m4 (revision 137216)
+++ m4/cshift1.m4 (working copy)
@@ -68,6 +68,7 @@ cshift1 (gfc_array_char * const restrict
index_type n;
int which;
'atype_name` sh;
+ index_type arraysize;
if (pwhich)
which = *pwhich - 1;
@@ -77,11 +78,13 @@ cshift1 (gfc_array_char * const restrict
if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array))
runtime_error ("Argument ''`DIM''` is out of range in call to ''`CSHIFT''`");
+ arraysize = size0 ((array_t *)array);
+
if (ret->data == NULL)
{
int i;
- ret->data = internal_malloc_size (size * size0 ((array_t *)array));
+ ret->data = internal_malloc_size (size * arraysize);
ret->offset = 0;
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
@@ -96,6 +99,9 @@ cshift1 (gfc_array_char * const restrict
}
}
+ if (arraysize == 0)
+ return;
+
extent[0] = 1;
count[0] = 0;
n = 0;
! { dg-do run }
! These used to segfault.
program main
real, dimension(1,0) :: a, b, c
a = 0
c = 0
b = cshift (a,1)
b = cshift (a,(/1/))
b = eoshift (a,1)
b = eoshift (a,(/1/))
b = eoshift (a,1,boundary=c)
b = eoshift (a,(/1/), boundary=c)
end program main