/* Implementation of the MINLOC intrinsic
- Copyright (C) 2017-2018 Free Software Foundation, Inc.
+ Copyright (C) 2017-2024 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_4)
#define HAVE_BACK_ARG 1
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
- GFC_DTYPE_COPY_SETRANK(retarray,retarray,1);
+ retarray->dtype.rank = 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
}
dest[n * dstride] = 1;
{
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *minval;
minval = NULL;
while (base)
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_4 *dest;
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
int mask_kind;
+ if (mask == NULL)
+ {
+#ifdef HAVE_BACK_ARG
+ minloc0_4_s1 (retarray, array, back, len);
+#else
+ minloc0_4_s1 (retarray, array, len);
+#endif
+ return;
+ }
+
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
- GFC_DTYPE_COPY_SETRANK(retarray,retarray,1);
+ retarray->dtype.rank = 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
}
dest[n * dstride] = 0;
{
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *minval;
minval = NULL;
index_type n;
GFC_INTEGER_4 *dest;
- if (*mask)
+ if (mask == NULL || *mask)
{
#ifdef HAVE_BACK_ARG
minloc0_4_s1 (retarray, array, back, len);
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
- GFC_DTYPE_COPY_SETRANK(retarray,retarray,1);
+ retarray->dtype.rank = 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
}