From 4292b27d501d5476beb1be16af134e6bac844906 Mon Sep 17 00:00:00 2001 From: tkoenig Date: Mon, 20 Mar 2006 21:56:00 +0000 Subject: 2006-03-20 Thomas Koenig PR fortran/20935 * iresolve.c (gfc_resolve_maxloc): If mask is scalar, prefix the function name with an "s". If the mask is scalar or if its kind is smaller than gfc_default_logical_kind, coerce it to default kind. (gfc_resolve_maxval): Likewise. (gfc_resolve_minloc): Likewise. (gfc_resolve_minval): Likewise. (gfc_resolve_product): Likewise. (gfc_resolve_sum): Likewise. 2006-03-20 Thomas Koenig PR fortran/20935 * m4/iforeach.m4: Add SCALAR_FOREACH_FUNCTION macro. * m4/ifunction.m4: Add SCALAR_ARRAY_FUNCTION macro. * m4/minloc0.m4: Use SCALAR_FOREACH_FUNCTION. * m4/minloc1.m4: Use SCALAR_ARRAY_FUNCTION. * m4/maxloc0.m4: Use SCALAR_FOREACH_FUNCTION. * m4/maxloc1.m4: Use SCALAR_ARRAY_FUNCTION. * m4/minval.m4: Likewise. * m4/maxval.m4: Likewise. * m4/product.m4: Likewise. * m4/sum.m4: Likewise. * minloc0_16_i16.c : Regenerated. * minloc0_16_i4.c : Regenerated. * minloc0_16_i8.c : Regenerated. * minloc0_16_r10.c : Regenerated. * minloc0_16_r16.c : Regenerated. * minloc0_16_r4.c : Regenerated. * minloc0_16_r8.c : Regenerated. * minloc0_4_i16.c : Regenerated. * minloc0_4_i4.c : Regenerated. * minloc0_4_i8.c : Regenerated. * minloc0_4_r10.c : Regenerated. * minloc0_4_r16.c : Regenerated. * minloc0_4_r4.c : Regenerated. * minloc0_4_r8.c : Regenerated. * minloc0_8_i16.c : Regenerated. * minloc0_8_i4.c : Regenerated. * minloc0_8_i8.c : Regenerated. * minloc0_8_r10.c : Regenerated. * minloc0_8_r16.c : Regenerated. * minloc0_8_r4.c : Regenerated. * minloc0_8_r8.c : Regenerated. * minloc1_16_i16.c : Regenerated. * minloc1_16_i4.c : Regenerated. * minloc1_16_i8.c : Regenerated. * minloc1_16_r10.c : Regenerated. * minloc1_16_r16.c : Regenerated. * minloc1_16_r4.c : Regenerated. * minloc1_16_r8.c : Regenerated. * minloc1_4_i16.c : Regenerated. * minloc1_4_i4.c : Regenerated. * minloc1_4_i8.c : Regenerated. * minloc1_4_r10.c : Regenerated. * minloc1_4_r16.c : Regenerated. * minloc1_4_r4.c : Regenerated. * minloc1_4_r8.c : Regenerated. * minloc1_8_i16.c : Regenerated. * minloc1_8_i4.c : Regenerated. * minloc1_8_i8.c : Regenerated. * minloc1_8_r10.c : Regenerated. * minloc1_8_r16.c : Regenerated. * minloc1_8_r4.c : Regenerated. * minloc1_8_r8.c : Regenerated. * maxloc0_16_i16.c : Regenerated. * maxloc0_16_i4.c : Regenerated. * maxloc0_16_i8.c : Regenerated. * maxloc0_16_r10.c : Regenerated. * maxloc0_16_r16.c : Regenerated. * maxloc0_16_r4.c : Regenerated. * maxloc0_16_r8.c : Regenerated. * maxloc0_4_i16.c : Regenerated. * maxloc0_4_i4.c : Regenerated. * maxloc0_4_i8.c : Regenerated. * maxloc0_4_r10.c : Regenerated. * maxloc0_4_r16.c : Regenerated. * maxloc0_4_r4.c : Regenerated. * maxloc0_4_r8.c : Regenerated. * maxloc0_8_i16.c : Regenerated. * maxloc0_8_i4.c : Regenerated. * maxloc0_8_i8.c : Regenerated. * maxloc0_8_r10.c : Regenerated. * maxloc0_8_r16.c : Regenerated. * maxloc0_8_r4.c : Regenerated. * maxloc0_8_r8.c : Regenerated. * maxloc1_16_i16.c : Regenerated. * maxloc1_16_i4.c : Regenerated. * maxloc1_16_i8.c : Regenerated. * maxloc1_16_r10.c : Regenerated. * maxloc1_16_r16.c : Regenerated. * maxloc1_16_r4.c : Regenerated. * maxloc1_16_r8.c : Regenerated. * maxloc1_4_i16.c : Regenerated. * maxloc1_4_i4.c : Regenerated. * maxloc1_4_i8.c : Regenerated. * maxloc1_4_r10.c : Regenerated. * maxloc1_4_r16.c : Regenerated. * maxloc1_4_r4.c : Regenerated. * maxloc1_4_r8.c : Regenerated. * maxloc1_8_i16.c : Regenerated. * maxloc1_8_i4.c : Regenerated. * maxloc1_8_i8.c : Regenerated. * maxloc1_8_r10.c : Regenerated. * maxloc1_8_r16.c : Regenerated. * maxloc1_8_r4.c : Regenerated. * maxloc1_8_r8.c : Regenerated. * maxval_i16.c : Regenerated. * maxval_i4.c : Regenerated. * maxval_i8.c : Regenerated. * maxval_r10.c : Regenerated. * maxval_r16.c : Regenerated. * maxval_r4.c : Regenerated. * maxval_r8.c : Regenerated. * minval_i16.c : Regenerated. * minval_i4.c : Regenerated. * minval_i8.c : Regenerated. * minval_r10.c : Regenerated. * minval_r16.c : Regenerated. * minval_r4.c : Regenerated. * minval_r8.c : Regenerated. * sum_c10.c : Regenerated. * sum_c16.c : Regenerated. * sum_c4.c : Regenerated. * sum_c8.c : Regenerated. * sum_i16.c : Regenerated. * sum_i4.c : Regenerated. * sum_i8.c : Regenerated. * sum_r10.c : Regenerated. * sum_r16.c : Regenerated. * sum_r4.c : Regenerated. * sum_r8.c : Regenerated. * product_c10.c : Regenerated. * product_c16.c : Regenerated. * product_c4.c : Regenerated. * product_c8.c : Regenerated. * product_i16.c : Regenerated. * product_i4.c : Regenerated. * product_i8.c : Regenerated. * product_r10.c : Regenerated. * product_r16.c : Regenerated. * product_r4.c : Regenerated. * product_r8.c : Regenerated. 2006-03-20 Thomas Koenig PR fortran/20935 * gfortran.dg/scalar_mask_2.f90: New test case. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@112230 138bc75d-0d04-0410-961f-82ee72b054a4 --- libgfortran/m4/iforeach.m4 | 53 ++++++++++++++++++++++++++++++++++++++++++++ libgfortran/m4/ifunction.m4 | 54 +++++++++++++++++++++++++++++++++++++++++++++ libgfortran/m4/maxloc0.m4 | 1 + libgfortran/m4/maxloc1.m4 | 2 ++ libgfortran/m4/maxval.m4 | 2 ++ libgfortran/m4/minloc0.m4 | 1 + libgfortran/m4/minloc1.m4 | 2 ++ libgfortran/m4/minval.m4 | 2 ++ libgfortran/m4/product.m4 | 2 ++ libgfortran/m4/sum.m4 | 2 ++ 10 files changed, 121 insertions(+) (limited to 'libgfortran/m4') diff --git a/libgfortran/m4/iforeach.m4 b/libgfortran/m4/iforeach.m4 index cfe563952bb..7d20213e9aa 100644 --- a/libgfortran/m4/iforeach.m4 +++ b/libgfortran/m4/iforeach.m4 @@ -248,3 +248,56 @@ $1 START_MASKED_FOREACH_BLOCK $2 FINISH_MASKED_FOREACH_FUNCTION')dnl +define(SCALAR_FOREACH_FUNCTION, +` +extern void `s'name`'rtype_qual`_'atype_code (rtype * const restrict, + atype * const restrict, GFC_LOGICAL_4 *); +export_proto(`s'name`'rtype_qual`_'atype_code); + +void +`s'name`'rtype_qual`_'atype_code (rtype * const restrict retarray, + atype * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + rtype_name *dest; + + if (*mask) + { + name`'rtype_qual`_'atype_code (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (rtype_name) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (rtype_name) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = $1 ; +}')dnl define(ARRAY_FUNCTION, `START_ARRAY_FUNCTION $2 diff --git a/libgfortran/m4/maxloc0.m4 b/libgfortran/m4/maxloc0.m4 index 9feaa4b99b8..a7e88f0b2ce 100644 --- a/libgfortran/m4/maxloc0.m4 +++ b/libgfortran/m4/maxloc0.m4 @@ -64,4 +64,5 @@ MASKED_FOREACH_FUNCTION( dest[n * dstride] = count[n] + 1; }') +SCALAR_FOREACH_FUNCTION(`0') #endif diff --git a/libgfortran/m4/maxloc1.m4 b/libgfortran/m4/maxloc1.m4 index 161368482f6..3a6ed5ad974 100644 --- a/libgfortran/m4/maxloc1.m4 +++ b/libgfortran/m4/maxloc1.m4 @@ -60,4 +60,6 @@ MASKED_ARRAY_FUNCTION(0, result = (rtype_name)n + 1; }') +SCALAR_ARRAY_FUNCTION(0) + #endif diff --git a/libgfortran/m4/maxval.m4 b/libgfortran/m4/maxval.m4 index 9bdf0d07cdd..07cbbdd6ac6 100644 --- a/libgfortran/m4/maxval.m4 +++ b/libgfortran/m4/maxval.m4 @@ -49,4 +49,6 @@ MASKED_ARRAY_FUNCTION(atype_min, ` if (*msrc && *src > result) result = *src;') +SCALAR_ARRAY_FUNCTION(atype_min) + #endif diff --git a/libgfortran/m4/minloc0.m4 b/libgfortran/m4/minloc0.m4 index 1c2aa18cf08..33bfe312a54 100644 --- a/libgfortran/m4/minloc0.m4 +++ b/libgfortran/m4/minloc0.m4 @@ -64,4 +64,5 @@ MASKED_FOREACH_FUNCTION( dest[n * dstride] = count[n] + 1; }') +SCALAR_FOREACH_FUNCTION(`0') #endif diff --git a/libgfortran/m4/minloc1.m4 b/libgfortran/m4/minloc1.m4 index 0c116eb63be..f923ca80410 100644 --- a/libgfortran/m4/minloc1.m4 +++ b/libgfortran/m4/minloc1.m4 @@ -60,4 +60,6 @@ MASKED_ARRAY_FUNCTION(0, result = (rtype_name)n + 1; }') +SCALAR_ARRAY_FUNCTION(0) + #endif diff --git a/libgfortran/m4/minval.m4 b/libgfortran/m4/minval.m4 index 9bd37f4d1fb..af02319c1dd 100644 --- a/libgfortran/m4/minval.m4 +++ b/libgfortran/m4/minval.m4 @@ -49,4 +49,6 @@ MASKED_ARRAY_FUNCTION(atype_max, ` if (*msrc && *src < result) result = *src;') +SCALAR_ARRAY_FUNCTION(atype_max) + #endif diff --git a/libgfortran/m4/product.m4 b/libgfortran/m4/product.m4 index df77372e8b0..47ee25b8b80 100644 --- a/libgfortran/m4/product.m4 +++ b/libgfortran/m4/product.m4 @@ -47,4 +47,6 @@ MASKED_ARRAY_FUNCTION(1, ` if (*msrc) result *= *src;') +SCALAR_ARRAY_FUNCTION(1) + #endif diff --git a/libgfortran/m4/sum.m4 b/libgfortran/m4/sum.m4 index 1d91c0d5100..a9406882cfa 100644 --- a/libgfortran/m4/sum.m4 +++ b/libgfortran/m4/sum.m4 @@ -47,4 +47,6 @@ MASKED_ARRAY_FUNCTION(0, ` if (*msrc) result += *src;') +SCALAR_ARRAY_FUNCTION(0) + #endif -- cgit v1.2.1