re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)

2017-11-04  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/29600
	* gfortran.h (gfc_check_f): Replace fm3l with fm4l.
	* intrinsic.h (gfc_resolve_maxloc): Add gfc_expr * to argument
	list in protoytpe.
	(gfc_resolve_minloc): Likewise.
	* check.c (gfc_check_minloc_maxloc): Handle kind argument.
	* intrinsic.c (add_sym_3_ml): Rename to
	(add_sym_4_ml): and handle kind argument.
	(add_function): Replace add_sym_3ml with add_sym_4ml and add
	extra arguments for maxloc and minloc.
	(check_specific): Change use of check.f3ml with check.f4ml.
	* iresolve.c (gfc_resolve_maxloc): Handle kind argument. If
	the kind is smaller than the smallest library version available,
	use gfc_default_integer_kind and convert afterwards.
	(gfc_resolve_minloc): Likewise.

2017-11-04  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/29600
	* gfortran.dg/minmaxloc_8.f90: New test.

From-SVN: r254405

1 files changed, 14 insertions, 12 deletions

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index da96e8f..cb18b21 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -687,27 +687,29 @@ add_sym_3 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt ty
    might have to be reordered.  */
 
 static void
-add_sym_3ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
+add_sym_4ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
 	     int kind, int standard,
 	     bool (*check) (gfc_actual_arglist *),
-	     gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
-	     void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
+	     gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
+	     void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
 	     const char *a1, bt type1, int kind1, int optional1,
 	     const char *a2, bt type2, int kind2, int optional2,
-	     const char *a3, bt type3, int kind3, int optional3)
+	     const char *a3, bt type3, int kind3, int optional3,
+	     const char *a4, bt type4, int kind4, int optional4)
 {
   gfc_check_f cf;
   gfc_simplify_f sf;
   gfc_resolve_f rf;
 
-  cf.f3ml = check;
-  sf.f3 = simplify;
-  rf.f3 = resolve;
+  cf.f4ml = check;
+  sf.f4 = simplify;
+  rf.f4 = resolve;
 
   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 	   a1, type1, kind1, optional1, INTENT_IN,
 	   a2, type2, kind2, optional2, INTENT_IN,
 	   a3, type3, kind3, optional3, INTENT_IN,
+	   a4, type4, kind4, optional4, INTENT_IN,
 	   (void *) 0);
 }
 
@@ -2455,10 +2457,10 @@ add_functions (void)
 
   make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
 
-  add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+  add_sym_4ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
 	       gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
 	       ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
-	       msk, BT_LOGICAL, dl, OPTIONAL);
+	       msk, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
 
   make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
 
@@ -2531,10 +2533,10 @@ add_functions (void)
 
   make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
 
-  add_sym_3ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+  add_sym_4ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
 	       gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
 	       ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
-	       msk, BT_LOGICAL, dl, OPTIONAL);
+	       msk, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
 
   make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
 
@@ -4498,7 +4500,7 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
   if (!do_ts29113_check (specific, *ap))
     return false;
 
-  if (specific->check.f3ml == gfc_check_minloc_maxloc)
+  if (specific->check.f4ml == gfc_check_minloc_maxloc)
     /* This is special because we might have to reorder the argument list.  */
     t = gfc_check_minloc_maxloc (*ap);
   else if (specific->check.f3red == gfc_check_minval_maxval)