From 3ba7edcfcccc8c37983e89ee9d80287e6e3bb0f4 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Thu, 21 Oct 2010 12:25:12 +0000 Subject: [PATCH] re PR fortran/46007 (wrong code for SHAPE in a scalarized loop) 2010-10-21 Thomas Koenig PR fortran/46007 * m4/shape.m4 (shape_'rtype_kind`): Use variable for rank. Allocate return array if unallocated. * generated/shape_i4.c: Regenerated. * generated/shape_i8.c: Regenerated. * generated/shape_i16.c: Regenerated. 2010-10-21 Thomas Koenig PR fortran/46007 * gfortran.dg/shape_5.f90: New test case. From-SVN: r165770 --- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/shape_5.f90 | 8 ++++++++ libgfortran/ChangeLog | 9 +++++++++ libgfortran/generated/shape_i16.c | 12 +++++++++++- libgfortran/generated/shape_i4.c | 12 +++++++++++- libgfortran/generated/shape_i8.c | 12 +++++++++++- libgfortran/m4/shape.m4 | 12 +++++++++++- 7 files changed, 66 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/shape_5.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 51877d14545..b4f914e808c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-10-21 Thomas Koenig + + PR fortran/46007 + * gfortran.dg/shape_5.f90: New test case. + 2010-10-21 Janus Weil PR fortran/46060 diff --git a/gcc/testsuite/gfortran.dg/shape_5.f90 b/gcc/testsuite/gfortran.dg/shape_5.f90 new file mode 100644 index 00000000000..ed128bcd202 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/shape_5.f90 @@ -0,0 +1,8 @@ +! { dg-do run } +! PR 40067 - this used to segfault on an unallocated return array. + integer, dimension(10) :: int1d + integer, dimension(:), pointer :: int1d_retrieved + + allocate(int1d_retrieved(10)) + if (any(shape(int1d_retrieved) /= shape(INT1D))) call abort() + end diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index c47cac370b5..5b06cef1b4f 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,12 @@ +2010-10-21 Thomas Koenig + + PR fortran/46007 + * m4/shape.m4 (shape_'rtype_kind`): Use variable for rank. + Allocate return array if unallocated. + * generated/shape_i4.c: Regenerated. + * generated/shape_i8.c: Regenerated. + * generated/shape_i16.c: Regenerated. + 2010-10-20 Jerry DeLisle PR libgfortran/46079 diff --git a/libgfortran/generated/shape_i16.c b/libgfortran/generated/shape_i16.c index 9ce28577baa..c2c52005a13 100644 --- a/libgfortran/generated/shape_i16.c +++ b/libgfortran/generated/shape_i16.c @@ -41,13 +41,23 @@ shape_16 (gfc_array_i16 * const restrict ret, int n; index_type stride; index_type extent; + int rank; + + rank = GFC_DESCRIPTOR_RANK (array); + + if (ret->data == NULL) + { + GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1); + ret->offset = 0; + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } stride = GFC_DESCRIPTOR_STRIDE(ret,0); if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) return; - for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++) + for (n = 0; n < rank; n++) { extent = GFC_DESCRIPTOR_EXTENT(array,n); ret->data[n * stride] = extent > 0 ? extent : 0 ; diff --git a/libgfortran/generated/shape_i4.c b/libgfortran/generated/shape_i4.c index 1b23335de56..0cef3327736 100644 --- a/libgfortran/generated/shape_i4.c +++ b/libgfortran/generated/shape_i4.c @@ -41,13 +41,23 @@ shape_4 (gfc_array_i4 * const restrict ret, int n; index_type stride; index_type extent; + int rank; + + rank = GFC_DESCRIPTOR_RANK (array); + + if (ret->data == NULL) + { + GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1); + ret->offset = 0; + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } stride = GFC_DESCRIPTOR_STRIDE(ret,0); if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) return; - for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++) + for (n = 0; n < rank; n++) { extent = GFC_DESCRIPTOR_EXTENT(array,n); ret->data[n * stride] = extent > 0 ? extent : 0 ; diff --git a/libgfortran/generated/shape_i8.c b/libgfortran/generated/shape_i8.c index efe00a5dd33..b457ae081c7 100644 --- a/libgfortran/generated/shape_i8.c +++ b/libgfortran/generated/shape_i8.c @@ -41,13 +41,23 @@ shape_8 (gfc_array_i8 * const restrict ret, int n; index_type stride; index_type extent; + int rank; + + rank = GFC_DESCRIPTOR_RANK (array); + + if (ret->data == NULL) + { + GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1); + ret->offset = 0; + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } stride = GFC_DESCRIPTOR_STRIDE(ret,0); if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) return; - for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++) + for (n = 0; n < rank; n++) { extent = GFC_DESCRIPTOR_EXTENT(array,n); ret->data[n * stride] = extent > 0 ? extent : 0 ; diff --git a/libgfortran/m4/shape.m4 b/libgfortran/m4/shape.m4 index eadd3b9b945..a289b0a8076 100644 --- a/libgfortran/m4/shape.m4 +++ b/libgfortran/m4/shape.m4 @@ -42,13 +42,23 @@ shape_'rtype_kind` ('rtype` * const restrict ret, int n; index_type stride; index_type extent; + int rank; + + rank = GFC_DESCRIPTOR_RANK (array); + + if (ret->data == NULL) + { + GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1); + ret->offset = 0; + ret->data = internal_malloc_size (sizeof ('rtype_name`) * rank); + } stride = GFC_DESCRIPTOR_STRIDE(ret,0); if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) return; - for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++) + for (n = 0; n < rank; n++) { extent = GFC_DESCRIPTOR_EXTENT(array,n); ret->data[n * stride] = extent > 0 ? extent : 0 ;