re PR fortran/54613 ([F08] Add FINDLOC plus support MAXLOC/MINLOC with KIND=/BACK=)

2017-10-28  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/54613
	* gfortran.h (gfc_isym_id): Add GFC_ISYM_FINDLOC.
	(gfc_check_f): Add f6fl field.
	(gfc_simplify_f): Add f6 field.
	(gfc_resolve_f): Likewise.
	(gfc_type_letter): Add optional logical_equas_int flag.
	* check.c (intrinsic_type_check): New function.
	(gfc_check_findloc): New function.
	* intrinsics.c (gfc_type_letter): If logical_equals_int is
	set, act accordingly.
	(add_sym_5ml):  Reformat comment.
	(add_sym_6fl): New function.
	(add_functions): Add findloc.
	(check_arglist): Add sixth argument, handle it.
	(resolve_intrinsic): Likewise.
	(check_specific): Handle findloc.
	* intrinsic.h (gfc_check_findloc): Add prototype.
	(gfc_simplify_findloc): Likewise.
	(gfc_resolve_findloc): Likewise.
	(MAX_INTRINSIC_ARGS): Adjust.
	* iresolve.c (gfc_resolve_findloc): New function.
	* simplify.c (gfc_simplify_minmaxloc): Make static.
	(simplify_findloc_to_scalar): New function.
	(simplify_findloc_nodim): New function.
	(simplify_findloc_to_array): New function.
	(gfc_simplify_findloc): New function.
	(gfc_conv_intrinsic_findloc): New function.
	(gfc_conv_intrinsic_function): Handle GFC_ISYM_FINDLOC.
	(gfc_is_intrinsic_libcall): Likewise.

2017-10-28  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/54613
	* Makefile.am: Add files for findloc.
	* Makefile.in: Regenerated.
	* libgfortran.h (gfc_array_index_type): Add.
	(gfc_array_s1): Add using GFC_UINTEGER_1.
	(gfc_array_s4): Likewise.
	Replace unnecessary comment.
	(HAVE_GFC_UINTEGER_1): Define.
	(HAVE_GFC_UINTEGER_4): Define.
	* m4/findloc0.m4: New file.
	* m4/findloc0s.m4: New file.
	* m4/findloc1.m4: New file.
	* m4/findloc1s.m4: New file.
	* m4/findloc2s.m4: New file.
	* m4/ifindloc0.m4: New file.
	* m4/ifindloc1.m4: New file.
	* m4/ifindloc2.m4: New file.
	* m4/iparm.m4: Use unsigned integer for characters.
        * generated/findloc0_c16.c: New file.
        * generated/findloc0_c4.c: New file.
        * generated/findloc0_c8.c: New file.
        * generated/findloc0_i1.c: New file.
        * generated/findloc0_i16.c: New file.
        * generated/findloc0_i2.c: New file.
        * generated/findloc0_i4.c: New file.
        * generated/findloc0_i8.c: New file.
        * generated/findloc0_r16.c: New file.
        * generated/findloc0_r4.c: New file.
        * generated/findloc0_r8.c: New file.
        * generated/findloc0_s1.c: New file.
        * generated/findloc0_s4.c: New file.
        * generated/findloc1_c16.c: New file.
        * generated/findloc1_c4.c: New file.
        * generated/findloc1_c8.c: New file.
        * generated/findloc1_i1.c: New file.
        * generated/findloc1_i16.c: New file.
        * generated/findloc1_i2.c: New file.
        * generated/findloc1_i4.c: New file.
        * generated/findloc1_i8.c: New file.
        * generated/findloc1_r16.c: New file.
        * generated/findloc1_r4.c: New file.
        * generated/findloc1_r8.c: New file.
        * generated/findloc1_s1.c: New file.
        * generated/findloc1_s4.c: New file.
        * generated/findloc2_s1.c: New file.
        * generated/findloc2_s4.c: New file.
        * generated/maxloc0_16_s1.c: Regenerated.
        * generated/maxloc0_16_s4.c: Regenerated.
        * generated/maxloc0_4_s1.c: Regenerated.
        * generated/maxloc0_4_s4.c: Regenerated.
        * generated/maxloc0_8_s1.c: Regenerated.
        * generated/maxloc0_8_s4.c: Regenerated.
        * generated/maxloc1_16_s1.c: Regenerated.
        * generated/maxloc1_16_s4.c: Regenerated.
        * generated/maxloc1_4_s1.c: Regenerated.
        * generated/maxloc1_4_s4.c: Regenerated.
        * generated/maxloc1_8_s1.c: Regenerated.
        * generated/maxloc1_8_s4.c: Regenerated.
        * generated/maxloc2_16_s1.c: Regenerated.
        * generated/maxloc2_16_s4.c: Regenerated.
        * generated/maxloc2_4_s1.c: Regenerated.
        * generated/maxloc2_4_s4.c: Regenerated.
        * generated/maxloc2_8_s1.c: Regenerated.
        * generated/maxloc2_8_s4.c: Regenerated.
        * generated/maxval0_s1.c: Regenerated.
        * generated/maxval0_s4.c: Regenerated.
        * generated/maxval1_s1.c: Regenerated.
        * generated/maxval1_s4.c: Regenerated.
        * generated/minloc0_16_s1.c: Regenerated.
        * generated/minloc0_16_s4.c: Regenerated.
        * generated/minloc0_4_s1.c: Regenerated.
        * generated/minloc0_4_s4.c: Regenerated.
        * generated/minloc0_8_s1.c: Regenerated.
        * generated/minloc0_8_s4.c: Regenerated.
        * generated/minloc1_16_s1.c: Regenerated.
        * generated/minloc1_16_s4.c: Regenerated.
        * generated/minloc1_4_s1.c: Regenerated.
        * generated/minloc1_4_s4.c: Regenerated.
        * generated/minloc1_8_s1.c: Regenerated.
        * generated/minloc1_8_s4.c: Regenerated.
        * generated/minloc2_16_s1.c: Regenerated.
        * generated/minloc2_16_s4.c: Regenerated.
        * generated/minloc2_4_s1.c: Regenerated.
        * generated/minloc2_4_s4.c: Regenerated.
        * generated/minloc2_8_s1.c: Regenerated.
        * generated/minloc2_8_s4.c: Regenerated.
        * generated/minval0_s1.c: Regenerated.
        * generated/minval0_s4.c: Regenerated.
        * generated/minval1_s1.c: Regenerated.
        * generated/minval1_s4.c: Regenerated.

2017-10-28  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/54613
	* gfortran.dg/findloc_1.f90: New test.
	* gfortran.dg/findloc_2.f90: New test.
	* gfortran.dg/findloc_3.f90: New test.
	* gfortran.dg/findloc_4.f90: New test.
	* gfortran.dg/findloc_5.f90: New test.
	* gfortran.dg/findloc_6.f90: New test.

From-SVN: r265570

1 files changed, 81 insertions, 10 deletions

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 6096686..17978c1 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -60,17 +60,22 @@ enum klass
 
 
 /* Return a letter based on the passed type.  Used to construct the
-   name of a type-dependent subroutine.  */
+   name of a type-dependent subroutine.  If logical_equals_int is
+   true, we can treat a logical like an int.  */
 
 char
-gfc_type_letter (bt type)
+gfc_type_letter (bt type, bool logical_equals_int)
 {
   char c;
 
   switch (type)
     {
     case BT_LOGICAL:
-      c = 'l';
+      if (logical_equals_int)
+	c = 'i';
+      else
+	c = 'l';
+
       break;
     case BT_CHARACTER:
       c = 's';
@@ -683,8 +688,8 @@ add_sym_3 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt ty
 }
 
 
-/* MINLOC and MAXLOC get special treatment because their argument
-   might have to be reordered.  */
+/* MINLOC and MAXLOC get special treatment because their
+   argument might have to be reordered.  */
 
 static void
 add_sym_5ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
@@ -717,6 +722,42 @@ add_sym_5ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt
 	   (void *) 0);
 }
 
+/* Similar for FINDLOC.  */
+
+static void
+add_sym_6fl (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 *,
+				    gfc_expr *, gfc_expr *, gfc_expr *),
+	     void (*resolve) (gfc_expr *, gfc_expr *, 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 *a4, bt type4, int kind4, int optional4,
+	     const char *a5, bt type5, int kind5, int optional5,
+	     const char *a6, bt type6, int kind6, int optional6)
+
+{
+  gfc_check_f cf;
+  gfc_simplify_f sf;
+  gfc_resolve_f rf;
+
+  cf.f6fl = check;
+  sf.f6 = simplify;
+  rf.f6 = 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,
+	   a5, type5, kind5, optional5, INTENT_IN,
+	   a6, type6, kind6, optional6, INTENT_IN,
+	   (void *) 0);
+}
+
 
 /* MINVAL, MAXVAL, PRODUCT, and SUM also get special treatment because
    their argument also might have to be reordered.  */
@@ -1248,7 +1289,8 @@ add_functions (void)
     *sta = "string_a", *stb = "string_b", *stg = "string",
     *sub = "sub", *sz = "size", *tg = "target", *team = "team", *tm = "time",
     *ts = "tsource", *ut = "unit", *v = "vector", *va = "vector_a",
-    *vb = "vector_b", *vl = "values", *x = "x", *y = "y", *z = "z";
+    *vb = "vector_b", *vl = "values", *val = "value", *x = "x", *y = "y",
+    *z = "z";
 
   int di, dr, dd, dl, dc, dz, ii;
 
@@ -2476,6 +2518,15 @@ add_functions (void)
 
   make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
 
+  add_sym_6fl ("findloc", GFC_ISYM_FINDLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
+	       BT_INTEGER, di, GFC_STD_F2008,
+	       gfc_check_findloc, gfc_simplify_findloc, gfc_resolve_findloc,
+	       ar, BT_REAL, dr, REQUIRED, val, BT_REAL, dr, REQUIRED,
+	       dm, BT_INTEGER, ii, OPTIONAL, msk, BT_LOGICAL, dl, OPTIONAL,
+	       kind, BT_INTEGER, di, OPTIONAL, bck, BT_LOGICAL, dl, OPTIONAL);
+
+  make_generic ("findloc", GFC_ISYM_FINDLOC, GFC_STD_F2008);
+
   add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
 		gfc_check_minval_maxval, gfc_simplify_maxval, gfc_resolve_maxval,
 		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
@@ -4279,7 +4330,7 @@ check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
 static void
 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
 {
-  gfc_expr *a1, *a2, *a3, *a4, *a5;
+  gfc_expr *a1, *a2, *a3, *a4, *a5, *a6;
   gfc_actual_arglist *arg;
 
   if (specific->resolve.f1 == NULL)
@@ -4353,6 +4404,15 @@ resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
       return;
     }
 
+  a6 = arg->expr;
+  arg = arg->next;
+
+  if (arg == NULL)
+    {
+      (*specific->resolve.f6) (e, a1, a2, a3, a4, a5, a6);
+      return;
+    }
+
   gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
 }
 
@@ -4366,7 +4426,7 @@ resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
 static bool
 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
 {
-  gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
+  gfc_expr *result, *a1, *a2, *a3, *a4, *a5, *a6;
   gfc_actual_arglist *arg;
 
   /* Max and min require special handling due to the variable number
@@ -4447,8 +4507,17 @@ do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
 		  if (arg == NULL)
 		    result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
 		  else
-		    gfc_internal_error
-		      ("do_simplify(): Too many args for intrinsic");
+		    {
+		      a6 = arg->expr;
+		      arg = arg->next;
+
+		      if (arg == NULL)
+			result = (*specific->simplify.f6)
+		       			(a1, a2, a3, a4, a5, a6);
+		      else
+			gfc_internal_error
+			  ("do_simplify(): Too many args for intrinsic");
+		    }
 		}
 	    }
 	}
@@ -4528,6 +4597,8 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
   if (specific->check.f5ml == 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.f6fl == gfc_check_findloc)
+    t = gfc_check_findloc (*ap);
   else if (specific->check.f3red == gfc_check_minval_maxval)
     /* This is also special because we also might have to reorder the
        argument list.  */