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

	PR fortran/29600

	* intrinsic.c (add_functions): Add KIND arguments to COUNT,
	IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
	and VERIFY.
	* iresolve.c (gfc_resolve_count): Add kind argument.
	(gfc_resolve_iachar): New function.
	(gfc_resolve_ichar): Add kind argument.
	(gfc_resolve_index_func): Likewise.
	(gfc_resolve_lbound): Likewise.
	(gfc_resolve_len): Likewise.
	(gfc_resolve_len_trim): Likewise.
	(gfc_resolve_scan): Likewise.
	(gfc_resolve_size): New function.
	(gfc_resolve_ubound): Add kind argument.
	(gfc_resolve_verify): Likewise.
	* trans-decl.c (gfc_get_extern_function_decl): Allow specific
	intrinsics to have 4 arguments.
	* check.c (gfc_check_count): Add kind argument.
	(gfc_check_ichar_iachar): Likewise.
	(gfc_check_index): Likewise.
	(gfc_check_lbound): Likewise.
	(gfc_check_len_lentrim): New function.
	(gfc_check_scan): Add kind argument.
	(gfc_check_size): Likewise.
	(gfc_check_ubound): Likewise.
	(gfc_check_verify): Likewise.
	* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
	INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
	* simplify.c (get_kind): Whitespace fix.
	(int_expr_with_kind): New function.
	(gfc_simplify_iachar): Add kind argument.
	(gfc_simplify_iachar): Likewise.
	(gfc_simplify_ichar): Likewise.
	(gfc_simplify_index): Likewise.
	(simplify_bound_dim): Likewise.
	(simplify_bound): Likewise.
	(gfc_simplify_lbound): Likewise.
	(gfc_simplify_len): Likewise.
	(gfc_simplify_len_trim): Likewise.
	(gfc_simplify_scan): Likewise.
	(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
	(gfc_simplify_size): Add kind argument.
	(gfc_simplify_ubound): Likewise.
	(gfc_simplify_verify): Likewise.
	* intrinsic.h: Update prototypes and add new ones.
	* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
	gfc_conv_intrinsic_index_scan_verify.
	(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
	(gfc_conv_intrinsic_function): Call
	gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
	SCAN and VERIFY intrinsics.

	* gfortran.dg/intrinsics_kind_argument_1.f90: New test.
	* gfortran.dg/pure_dummy_length_1.f90: Adapt to new error wording.

From-SVN: r127380

1 files changed, 84 insertions, 9 deletions

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index ba72aaa..f0de08f 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -786,12 +786,18 @@ gfc_check_complex (gfc_expr *x, gfc_expr *y)
 
 
 try
-gfc_check_count (gfc_expr *mask, gfc_expr *dim)
+gfc_check_count (gfc_expr *mask, gfc_expr *dim, gfc_expr *kind)
 {
   if (logical_array_check (mask, 0) == FAILURE)
     return FAILURE;
   if (dim_check (dim, 1, 1) == FAILURE)
     return FAILURE;
+  if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
 
   return SUCCESS;
 }
@@ -1088,13 +1094,21 @@ gfc_check_ibset (gfc_expr *i, gfc_expr *pos)
 
 
 try
-gfc_check_ichar_iachar (gfc_expr *c)
+gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind)
 {
   int i;
 
   if (type_check (c, 0, BT_CHARACTER) == FAILURE)
     return FAILURE;
 
+  if (kind_check (kind, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
   if (c->expr_type == EXPR_VARIABLE || c->expr_type == EXPR_SUBSTRING)
     {
       gfc_expr *start;
@@ -1181,16 +1195,23 @@ gfc_check_ieor (gfc_expr *i, gfc_expr *j)
 
 
 try
-gfc_check_index (gfc_expr *string, gfc_expr *substring, gfc_expr *back)
+gfc_check_index (gfc_expr *string, gfc_expr *substring, gfc_expr *back,
+		 gfc_expr *kind)
 {
   if (type_check (string, 0, BT_CHARACTER) == FAILURE
       || type_check (substring, 1, BT_CHARACTER) == FAILURE)
     return FAILURE;
 
-
   if (back != NULL && type_check (back, 2, BT_LOGICAL) == FAILURE)
     return FAILURE;
 
+  if (kind_check (kind, 3, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
   if (string->ts.kind != substring->ts.kind)
     {
       gfc_error ("'%s' argument of '%s' intrinsic at %L must be the same "
@@ -1335,7 +1356,7 @@ gfc_check_kind (gfc_expr *x)
 
 
 try
-gfc_check_lbound (gfc_expr *array, gfc_expr *dim)
+gfc_check_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 {
   if (array_check (array, 0) == FAILURE)
     return FAILURE;
@@ -1348,6 +1369,31 @@ gfc_check_lbound (gfc_expr *array, gfc_expr *dim)
       if (dim_rank_check (dim, array, 1) == FAILURE)
 	return FAILURE;
     }
+
+  if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+try
+gfc_check_len_lentrim (gfc_expr *s, gfc_expr *kind)
+{
+  if (type_check (s, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  if (kind_check (kind, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
   return SUCCESS;
 }
 
@@ -2160,7 +2206,7 @@ gfc_check_scale (gfc_expr *x, gfc_expr *i)
 
 
 try
-gfc_check_scan (gfc_expr *x, gfc_expr *y, gfc_expr *z)
+gfc_check_scan (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind)
 {
   if (type_check (x, 0, BT_CHARACTER) == FAILURE)
     return FAILURE;
@@ -2171,6 +2217,13 @@ gfc_check_scan (gfc_expr *x, gfc_expr *y, gfc_expr *z)
   if (z != NULL && type_check (z, 2, BT_LOGICAL) == FAILURE)
     return FAILURE;
 
+  if (kind_check (kind, 3, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
   if (same_type_check (x, 0, y, 1) == FAILURE)
     return FAILURE;
 
@@ -2276,7 +2329,7 @@ gfc_check_sign (gfc_expr *a, gfc_expr *b)
 
 
 try
-gfc_check_size (gfc_expr *array, gfc_expr *dim)
+gfc_check_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 {
   if (array_check (array, 0) == FAILURE)
     return FAILURE;
@@ -2293,6 +2346,14 @@ gfc_check_size (gfc_expr *array, gfc_expr *dim)
 	return FAILURE;
     }
 
+  if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
+
   return SUCCESS;
 }
 
@@ -2603,7 +2664,7 @@ gfc_check_transpose (gfc_expr *matrix)
 
 
 try
-gfc_check_ubound (gfc_expr *array, gfc_expr *dim)
+gfc_check_ubound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 {
   if (array_check (array, 0) == FAILURE)
     return FAILURE;
@@ -2617,6 +2678,13 @@ gfc_check_ubound (gfc_expr *array, gfc_expr *dim)
 	return FAILURE;
     }
 
+  if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
   return SUCCESS;
 }
 
@@ -2641,7 +2709,7 @@ gfc_check_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field)
 
 
 try
-gfc_check_verify (gfc_expr *x, gfc_expr *y, gfc_expr *z)
+gfc_check_verify (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind)
 {
   if (type_check (x, 0, BT_CHARACTER) == FAILURE)
     return FAILURE;
@@ -2652,6 +2720,13 @@ gfc_check_verify (gfc_expr *x, gfc_expr *y, gfc_expr *z)
   if (z != NULL && type_check (z, 2, BT_LOGICAL) == FAILURE)
     return FAILURE;
 
+  if (kind_check (kind, 3, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
   return SUCCESS;
 }