From ddc9995b13d71d00b97cb2c4c7d5e9ef1dcbe5ea Mon Sep 17 00:00:00 2001
From: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Wed, 22 Nov 2017 18:08:07 +0000
Subject: re PR fortran/36313 ([F03] {MIN,MAX}{LOC,VAL} should accept character
arguments)
2017-11-22 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/36313
* Makefile.am: Add i_maxloc0s_c, i_maxloc1s_c, i_maxloc2s_c,
i_minloc0s_c, i_minloc1s_c and i_minloc2s_c.
* Makefile.in: Regenerated.
* generated/maxloc0_16_s1.c: New file.
* generated/maxloc0_16_s4.c: New file.
* generated/maxloc0_4_s1.c: New file.
* generated/maxloc0_4_s4.c: New file.
* generated/maxloc0_8_s1.c: New file.
* generated/maxloc0_8_s4.c: New file.
* generated/maxloc1_16_s1.c: New file.
* generated/maxloc1_16_s4.c: New file.
* generated/maxloc1_4_s1.c: New file.
* generated/maxloc1_4_s4.c: New file.
* generated/maxloc1_8_s1.c: New file.
* generated/maxloc1_8_s4.c: New file.
* generated/maxloc2_16_s1.c: New file.
* generated/maxloc2_16_s4.c: New file.
* generated/maxloc2_4_s1.c: New file.
* generated/maxloc2_4_s4.c: New file.
* generated/maxloc2_8_s1.c: New file.
* generated/maxloc2_8_s4.c: New file.
* generated/minloc0_16_s1.c: New file.
* generated/minloc0_16_s4.c: New file.
* generated/minloc0_4_s1.c: New file.
* generated/minloc0_4_s4.c: New file.
* generated/minloc0_8_s1.c: New file.
* generated/minloc0_8_s4.c: New file.
* generated/minloc1_16_s1.c: New file.
* generated/minloc1_16_s4.c: New file.
* generated/minloc1_4_s1.c: New file.
* generated/minloc1_4_s4.c: New file.
* generated/minloc1_8_s1.c: New file.
* generated/minloc1_8_s4.c: New file.
* generated/minloc2_16_s1.c: New file.
* generated/minloc2_16_s4.c: New file.
* generated/minloc2_4_s1.c: New file.
* generated/minloc2_4_s4.c: New file.
* generated/minloc2_8_s1.c: New file.
* generated/minloc2_8_s4.c: New file.
* m4/iforeach-s.m4: New file.
* m4/ifunction-s.m4: New file.
* m4/maxloc0s.m4: New file.
* m4/maxloc1s.m4: New file.
* m4/maxloc2s.m4: New file.
* m4/minloc0s.m4: New file.
* m4/minloc1s.m4: New file.
* m4/minloc2s.m4: New file.
* gfortran.map: Add new functions.
* libgfortran.h: Add gfc_array_s1 and gfc_array_s4.
2017-11-22 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/36313
* check.c (int_or_real_or_char_check_f2003): New function.
* iresolve.c (gfc_resolve_maxloc): Add number "2" for
character arguments and rank-zero return value.
(gfc_resolve_minloc): Likewise.
* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Handle case of
character arguments and rank-zero return value by removing
unneeded arguments and calling the library function.
2017-11-22 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/36313
* gfortran.dg/maxloc_string_1.f90: New test.
* gfortran.dg/minloc_string_1.f90: New test.
From-SVN: r255070
---
gcc/fortran/check.c | 33 ++++++++++++++++++++++++++++++++-
1 file changed, 32 insertions(+), 1 deletion(-)
(limited to 'gcc/fortran/check.c')
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index a147449..2928172 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -117,6 +117,37 @@ int_or_real_check (gfc_expr *e, int n)
return true;
}
+/* Check that an expression is integer or real; allow character for
+ F2003 or later. */
+
+static bool
+int_or_real_or_char_check_f2003 (gfc_expr *e, int n)
+{
+ if (e->ts.type != BT_INTEGER && e->ts.type != BT_REAL)
+ {
+ if (e->ts.type == BT_CHARACTER)
+ return gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Character for "
+ "%qs argument of %qs intrinsic at %L",
+ gfc_current_intrinsic_arg[n]->name,
+ gfc_current_intrinsic, &e->where);
+ else
+ {
+ if (gfc_option.allow_std & GFC_STD_F2003)
+ gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
+ "or REAL or CHARACTER",
+ gfc_current_intrinsic_arg[n]->name,
+ gfc_current_intrinsic, &e->where);
+ else
+ gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
+ "or REAL", gfc_current_intrinsic_arg[n]->name,
+ gfc_current_intrinsic, &e->where);
+ }
+ return false;
+ }
+
+ return true;
+}
+
/* Check that an expression is real or complex. */
@@ -3189,7 +3220,7 @@ gfc_check_minloc_maxloc (gfc_actual_arglist *ap)
gfc_expr *a, *m, *d, *k;
a = ap->expr;
- if (!int_or_real_check (a, 0) || !array_check (a, 0))
+ if (!int_or_real_or_char_check_f2003 (a, 0) || !array_check (a, 0))
return false;
d = ap->next->expr;
--
cgit v1.1