[patch, libfortran] Fix PR 22144, committed
Thomas Koenig
Thomas.Koenig@online.de
Sat Jun 25 09:58:00 GMT 2005
I just committed the patch below to mainline, as obviously
correct after regression-testing.
2005-06-25 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/22144
* m4/cshift1.m4: Remove const from argument ret.
Populate return array descriptor if ret->data is NULL.
* m4/eoshift1.m4: Likewise.
* m4/eoshift3.m4: Likewise.
* generated/cshift1_4.c: Regenerated.
* generated/cshift1_8.c: Regenerated.
* generated/eoshift1_4.c: Regenerated.
* generated/eoshift1_8.c: Regenerated.
* generated/eoshift3_4.c: Regenerated.
* generated/eoshift3_8.c: Regenerated.
2005-06-25 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/21144
* gfortran.dg/shift-alloc.f90: New testcase.
-------------- next part --------------
Index: m4/cshift1.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/cshift1.m4,v
retrieving revision 1.7
diff -c -p -r1.7 cshift1.m4
*** m4/cshift1.m4 4 May 2005 21:38:15 -0000 1.7
--- m4/cshift1.m4 25 Jun 2005 07:51:07 -0000
*************** Boston, MA 02111-1307, USA. */
*** 35,47 ****
#include "libgfortran.h"'
include(iparm.m4)dnl
! void cshift1_`'atype_kind (const gfc_array_char * ret,
const gfc_array_char * array,
const atype * h, const atype_name * pwhich);
export_proto(cshift1_`'atype_kind);
void
! cshift1_`'atype_kind (const gfc_array_char * ret,
const gfc_array_char * array,
const atype * h, const atype_name * pwhich)
{
--- 35,47 ----
#include "libgfortran.h"'
include(iparm.m4)dnl
! void cshift1_`'atype_kind (gfc_array_char * ret,
const gfc_array_char * array,
const atype * h, const atype_name * pwhich);
export_proto(cshift1_`'atype_kind);
void
! cshift1_`'atype_kind (gfc_array_char * ret,
const gfc_array_char * array,
const atype * h, const atype_name * pwhich)
{
*************** cshift1_`'atype_kind (const gfc_array_ch
*** 81,86 ****
--- 81,105 ----
size = GFC_DESCRIPTOR_SIZE (ret);
+ if (ret->data == NULL)
+ {
+ int i;
+
+ ret->data = internal_malloc_size (size * size0 ((array_t *)array));
+ ret->base = 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;
+ }
+ }
+
extent[0] = 1;
count[0] = 0;
size = GFC_DESCRIPTOR_SIZE (array);
Index: m4/eoshift1.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/eoshift1.m4,v
retrieving revision 1.8
diff -c -p -r1.8 eoshift1.m4
*** m4/eoshift1.m4 15 May 2005 15:50:07 -0000 1.8
--- m4/eoshift1.m4 25 Jun 2005 07:51:07 -0000
*************** include(iparm.m4)dnl
*** 38,51 ****
static const char zeros[16] =
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
! extern void eoshift1_`'atype_kind (const gfc_array_char *,
const gfc_array_char *,
const atype *, const char *,
const atype_name *);
export_proto(eoshift1_`'atype_kind);
void
! eoshift1_`'atype_kind (const gfc_array_char *ret,
const gfc_array_char *array,
const atype *h, const char *pbound,
const atype_name *pwhich)
--- 38,51 ----
static const char zeros[16] =
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
! extern void eoshift1_`'atype_kind (gfc_array_char *,
const gfc_array_char *,
const atype *, const char *,
const atype_name *);
export_proto(eoshift1_`'atype_kind);
void
! eoshift1_`'atype_kind (gfc_array_char *ret,
const gfc_array_char *array,
const atype *h, const char *pbound,
const atype_name *pwhich)
*************** eoshift1_`'atype_kind (const gfc_array_c
*** 96,101 ****
--- 96,121 ----
extent[0] = 1;
count[0] = 0;
size = GFC_DESCRIPTOR_SIZE (array);
+
+ if (ret->data == NULL)
+ {
+ int i;
+
+ ret->data = internal_malloc_size (size * size0 ((array_t *)array));
+ ret->base = 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;
+ }
+ }
+
n = 0;
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
{
Index: m4/eoshift3.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/eoshift3.m4,v
retrieving revision 1.8
diff -c -p -r1.8 eoshift3.m4
*** m4/eoshift3.m4 15 May 2005 15:50:07 -0000 1.8
--- m4/eoshift3.m4 25 Jun 2005 07:51:07 -0000
*************** eoshift3_`'atype_kind (gfc_array_char *r
*** 91,96 ****
--- 91,115 ----
which = 0;
size = GFC_DESCRIPTOR_SIZE (ret);
+ if (ret->data == NULL)
+ {
+ int i;
+
+ ret->data = internal_malloc_size (size * size0 ((array_t *)array));
+ ret->base = 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;
+ }
+ }
+
extent[0] = 1;
count[0] = 0;
-------------- next part --------------
! { dg do-run }
! PR 22144: eoshift1, eoshift3 and cshift1 used to lack memory
! allocation, which caused the writes to segfault.
program main
implicit none
integer, dimension (:,:),allocatable :: a
integer, dimension (3) :: sh, bo
character(len=80) line1, line2
integer :: i
allocate (a(3,3))
a = reshape((/(i,i=1,9)/),shape(a))
sh = (/ 2, -1, -2 /)
bo = (/ -3, -2, -1 /)
write(unit=line1,fmt='(10I5)') cshift(a, shift=sh)
write(unit=line1,fmt='(10I5)') eoshift(a, shift=sh)
write(unit=line1,fmt='(10I5)') eoshift(a, shift=sh, boundary=bo)
end program main
More information about the Fortran
mailing list