From 50dd63a96201720c74d336aad9197a0efa019e4d Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sat, 9 Apr 2005 21:38:47 +0000 Subject: re PR libfortran/19106 ([4.0 only] segfault in executable for print *,sum(a,dim=2,mask=a>0)) 2005-04-09 Thomas Koenig PR libfortran/19106 PR libfortran/19014 * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): ditto. If retarray->data is NULL (i.e. the front end does not know the rank and dimenson of the array), fill in its properties and allocate memory. Change the assertions about rank and dimension of retarray into runtime errors and only check them for retarray->data != NULL. Do the same for correcting the stride from 0 to 1 in retarray. (`m'name`'rtype_qual`_'atype_code): Likewise. * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Likewise. Change assertion about rank of array to runtime error. (`m'name`'rtype_qual`_'atype_code): Likewise. * generated/all_l4.c: Regenerated. * generated/all_l8.c: Regenerated. * generated/any_l4.c: Regenerated. * generated/any_l8.c: Regenerated. * generated/count_4_l4.c: Regenerated. * generated/count_4_l8.c: Regenerated. * generated/count_8_l4.c: Regenerated. * generated/count_8_l8.c: Regenerated. * generated/maxloc0_4_i4.c: Regenerated. * generated/maxloc0_4_i8.c: Regenerated. * generated/maxloc0_4_r4.c: Regenerated. * generated/maxloc0_4_r8.c: Regenerated. * generated/maxloc0_8_i4.c: Regenerated. * generated/maxloc0_8_i8.c: Regenerated. * generated/maxloc0_8_r4.c: Regenerated. * generated/maxloc0_8_r8.c: Regenerated. * generated/maxloc1_4_i4.c: Regenerated. * generated/maxloc1_4_i8.c: Regenerated. * generated/maxloc1_4_r4.c: Regenerated. * generated/maxloc1_4_r8.c: Regenerated. * generated/maxloc1_8_i4.c: Regenerated. * generated/maxloc1_8_i8.c: Regenerated. * generated/maxloc1_8_r4.c: Regenerated. * generated/maxloc1_8_r8.c: Regenerated. * generated/maxval_i4.c: Regenerated. * generated/maxval_i8.c: Regenerated. * generated/maxval_r4.c: Regenerated. * generated/maxval_r8.c: Regenerated. * generated/minloc0_4_i4.c: Regenerated. * generated/minloc0_4_i8.c: Regenerated. * generated/minloc0_4_r4.c: Regenerated. * generated/minloc0_4_r8.c: Regenerated. * generated/minloc0_8_i4.c: Regenerated. * generated/minloc0_8_i8.c: Regenerated. * generated/minloc0_8_r4.c: Regenerated. * generated/minloc0_8_r8.c: Regenerated. * generated/minloc1_4_i4.c: Regenerated. * generated/minloc1_4_i8.c: Regenerated. * generated/minloc1_4_r4.c: Regenerated. * generated/minloc1_4_r8.c: Regenerated. * generated/minloc1_8_i4.c: Regenerated. * generated/minloc1_8_i8.c: Regenerated. * generated/minloc1_8_r4.c: Regenerated. * generated/minloc1_8_r8.c: Regenerated. * generated/minval_i4.c: Regenerated. * generated/minval_i8.c: Regenerated. * generated/minval_r4.c: Regenerated. * generated/minval_r8.c: Regenerated. * generated/product_c4.c: Regenerated. * generated/product_c8.c: Regenerated. * generated/product_i4.c: Regenerated. * generated/product_i8.c: Regenerated. * generated/product_r4.c: Regenerated. * generated/product_r8.c: Regenerated. * generated/sum_c4.c: Regenerated. * generated/sum_c8.c: Regenerated. * generated/sum_i4.c: Regenerated. * generated/sum_i8.c: Regenerated. * generated/sum_r4.c: Regenerated. * generated/sum_r8.c: Regenerated. 2005-04-09 Thomas Koenig * gfortran.fortran-torture/execute/intrinsic_anyall.f90: Added test for callee-allocated arrays with write statements. * gfortran.fortran-torture/execute/intrinsic_count.f90: Likewise. * gfortran.fortran-torture/execute/intrinsic_mmloc.f90: Likewise. * gfortran.fortran-torture/execute/intrinsic_mmval.f90: Likewise. * gfortran.fortran-torture/execute/intrinsic_product.f90: Likewise. * gfortran.fortran-torture/execute/intrinsic_sum.f90: Likewise. From-SVN: r97929 --- libgfortran/generated/sum_c4.c | 45 +++++++++++++++++++++++++++++++++++------- 1 file changed, 38 insertions(+), 7 deletions(-) (limited to 'libgfortran/generated/sum_c4.c') diff --git a/libgfortran/generated/sum_c4.c b/libgfortran/generated/sum_c4.c index 37fd93c..74efd07 100644 --- a/libgfortran/generated/sum_c4.c +++ b/libgfortran/generated/sum_c4.c @@ -55,11 +55,8 @@ sum_c4 (gfc_array_c4 *retarray, gfc_array_c4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ sum_c4 (gfc_array_c4 *retarray, gfc_array_c4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -183,11 +189,8 @@ msum_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -209,6 +212,34 @@ msum_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; -- cgit v1.1