From 97a62038664e3b5f7e46ce900b2a090c79bb03bd Mon Sep 17 00:00:00 2001
From: Thomas Koenig <Thomas.Koenig@online.de>
Date: Mon, 20 Mar 2006 21:56:00 +0000
Subject: re PR fortran/20935 (failed assertion for maxloc(n, mask=.true.))
2006-03-20 Thomas Koenig <Thomas.Koenig@online.de>
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 <Thomas.Koenig@online.de>
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 <Thomas.Koenig@online.de>
PR fortran/20935
* gfortran.dg/scalar_mask_2.f90: New test case.
From-SVN: r112230
---
libgfortran/generated/minloc0_8_r10.c | 52 +++++++++++++++++++++++++++++++++++
1 file changed, 52 insertions(+)
(limited to 'libgfortran/generated/minloc0_8_r10.c')
diff --git a/libgfortran/generated/minloc0_8_r10.c b/libgfortran/generated/minloc0_8_r10.c
index c627e7e..8bd4251 100644
--- a/libgfortran/generated/minloc0_8_r10.c
+++ b/libgfortran/generated/minloc0_8_r10.c
@@ -293,4 +293,56 @@ mminloc0_8_r10 (gfc_array_i8 * const restrict retarray,
}
}
+
+extern void sminloc0_8_r10 (gfc_array_i8 * const restrict,
+ gfc_array_r10 * const restrict, GFC_LOGICAL_4 *);
+export_proto(sminloc0_8_r10);
+
+void
+sminloc0_8_r10 (gfc_array_i8 * const restrict retarray,
+ gfc_array_r10 * const restrict array,
+ GFC_LOGICAL_4 * mask)
+{
+ index_type rank;
+ index_type dstride;
+ index_type n;
+ GFC_INTEGER_8 *dest;
+
+ if (*mask)
+ {
+ minloc0_8_r10 (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 (GFC_INTEGER_8) * 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] = 0 ;
+}
#endif
--
cgit v1.1