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.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127380 138bc75d-0d04-0410-961f-82ee72b054a4

9 files changed, 459 insertions, 237 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index cbd28a51b7f..ecb75698b91 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,57 @@
+2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	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.
+
 2007-08-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR fortran/31189
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index ba72aaa862e..f0de08f3a21 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;
 }
 
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 71d53ff5948..59006b2ee24 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -1256,9 +1256,11 @@ add_functions (void)
 
   make_generic ("cosh", GFC_ISYM_COSH, GFC_STD_F77);
 
-  add_sym_2 ("count", GFC_ISYM_COUNT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+  add_sym_3 ("count", GFC_ISYM_COUNT, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F95,
 	     gfc_check_count, NULL, gfc_resolve_count,
-	     msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
+	     msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+	     kind, BT_INTEGER, di, OPTIONAL);
 
   make_generic ("count", GFC_ISYM_COUNT, GFC_STD_F95);
 
@@ -1484,9 +1486,10 @@ add_functions (void)
 
   make_generic ("huge", GFC_ISYM_HUGE, GFC_STD_F95);
 
-  add_sym_1 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
-	     gfc_check_ichar_iachar, gfc_simplify_iachar, NULL,
-	     c, BT_CHARACTER, dc, REQUIRED);
+  add_sym_2 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_ichar_iachar, gfc_simplify_iachar, gfc_resolve_iachar,
+	     c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
 
   make_generic ("iachar", GFC_ISYM_IACHAR, GFC_STD_F95);
 
@@ -1526,9 +1529,10 @@ add_functions (void)
 
   make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
 
-  add_sym_1 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
+  add_sym_2 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F77,
 	     gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
-	     c, BT_CHARACTER, dc, REQUIRED);
+	     c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
 
   make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
 
@@ -1551,10 +1555,11 @@ add_functions (void)
 
   /* The resolution function for INDEX is called gfc_resolve_index_func
      because the name gfc_resolve_index is already used in resolve.c.  */
-  add_sym_3 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
+  add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
+	     BT_INTEGER, di, GFC_STD_F77,
 	     gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
 	     stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
-	     bck, BT_LOGICAL, dl, OPTIONAL);
+	     bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
 
   make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
 
@@ -1660,21 +1665,25 @@ add_functions (void)
 
   make_generic ("kind", GFC_ISYM_KIND, GFC_STD_F95);
 
-  add_sym_2 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+  add_sym_3 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F95,
 	     gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
-	     ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL);
+	     ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL,
+	     kind, BT_INTEGER, di, OPTIONAL);
 
   make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
 
-  add_sym_1 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
-	     NULL, gfc_simplify_len, gfc_resolve_len,
-	     stg, BT_CHARACTER, dc, REQUIRED);
+  add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
+	     BT_INTEGER, di, GFC_STD_F77,
+	     gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
+	     stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
 
   make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
 
-  add_sym_1 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
-	     NULL, gfc_simplify_len_trim, gfc_resolve_len_trim,
-	     stg, BT_CHARACTER, dc, REQUIRED);
+  add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_len_lentrim, gfc_simplify_len_trim, gfc_resolve_len_trim,
+	     stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
 
   make_alias ("lnblnk", GFC_STD_GNU);
 
@@ -2040,10 +2049,11 @@ add_functions (void)
 
   make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
 
-  add_sym_3 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+  add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F95,
 	     gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
 	     stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
-	     bck, BT_LOGICAL, dl, OPTIONAL);
+	     bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
 
   make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
 
@@ -2136,9 +2146,11 @@ add_functions (void)
 
   make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
 
-  add_sym_2 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
-	     gfc_check_size, gfc_simplify_size, NULL,
-	     ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
+  add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_size, gfc_simplify_size, gfc_resolve_size,
+	     ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+	     kind, BT_INTEGER, di, OPTIONAL);
 
   make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
 
@@ -2267,9 +2279,11 @@ add_functions (void)
 
   make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
 
-  add_sym_2 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+  add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F95,
 	     gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
-	     ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
+	     ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+	     kind, BT_INTEGER, di, OPTIONAL);
 
   make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
 
@@ -2294,10 +2308,11 @@ add_functions (void)
 
   make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
 
-  add_sym_3 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+  add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F95,
 	     gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
 	     stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
-	     bck, BT_LOGICAL, dl, OPTIONAL);
+	     bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
 
   make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
     
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index c8548d14bdf..79cf3e52951 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -44,7 +44,7 @@ try gfc_check_chdir (gfc_expr *);
 try gfc_check_chmod (gfc_expr *, gfc_expr *);
 try gfc_check_cmplx (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_complex (gfc_expr *, gfc_expr *);
-try gfc_check_count (gfc_expr *, gfc_expr *);
+try gfc_check_count (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_ctime (gfc_expr *);
 try gfc_check_dcmplx (gfc_expr *, gfc_expr *);
@@ -69,10 +69,10 @@ try gfc_check_and (gfc_expr *, gfc_expr *);
 try gfc_check_ibclr (gfc_expr *, gfc_expr *);
 try gfc_check_ibits (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_ibset (gfc_expr *, gfc_expr *);
-try gfc_check_ichar_iachar (gfc_expr *);
+try gfc_check_ichar_iachar (gfc_expr *, gfc_expr *);
 try gfc_check_idnint (gfc_expr *);
 try gfc_check_ieor (gfc_expr *, gfc_expr *);
-try gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *);
+try gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_int (gfc_expr *, gfc_expr *);
 try gfc_check_intconv (gfc_expr *);
 try gfc_check_ior (gfc_expr *, gfc_expr *);
@@ -83,7 +83,8 @@ try gfc_check_ishft (gfc_expr *, gfc_expr *);
 try gfc_check_ishftc (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_kill (gfc_expr *, gfc_expr *);
 try gfc_check_kind (gfc_expr *);
-try gfc_check_lbound (gfc_expr *, gfc_expr *);
+try gfc_check_lbound (gfc_expr *, gfc_expr *, gfc_expr *);
+try gfc_check_len_lentrim (gfc_expr *, gfc_expr *);
 try gfc_check_link (gfc_expr *, gfc_expr *);
 try gfc_check_loc (gfc_expr *);
 try gfc_check_logical (gfc_expr *, gfc_expr *);
@@ -111,14 +112,14 @@ try gfc_check_rename (gfc_expr *, gfc_expr *);
 try gfc_check_repeat (gfc_expr *, gfc_expr *);
 try gfc_check_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_scale (gfc_expr *, gfc_expr *);
-try gfc_check_scan (gfc_expr *, gfc_expr *, gfc_expr *);
+try gfc_check_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_second_sub (gfc_expr *);
 try gfc_check_secnds (gfc_expr *);
 try gfc_check_selected_int_kind (gfc_expr *);
 try gfc_check_selected_real_kind (gfc_expr *, gfc_expr *);
 try gfc_check_set_exponent (gfc_expr *, gfc_expr *);
 try gfc_check_shape (gfc_expr *);
-try gfc_check_size (gfc_expr *, gfc_expr *);
+try gfc_check_size (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_sign (gfc_expr *, gfc_expr *);
 try gfc_check_signal (gfc_expr *, gfc_expr *);
 try gfc_check_sizeof (gfc_expr *);
@@ -131,11 +132,11 @@ try gfc_check_transfer (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_transpose (gfc_expr *);
 try gfc_check_trim (gfc_expr *);
 try gfc_check_ttynam (gfc_expr *);
-try gfc_check_ubound (gfc_expr *, gfc_expr *);
+try gfc_check_ubound (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_umask (gfc_expr *);
 try gfc_check_unlink (gfc_expr *);
 try gfc_check_unpack (gfc_expr *, gfc_expr *, gfc_expr *);
-try gfc_check_verify (gfc_expr *, gfc_expr *, gfc_expr *);
+try gfc_check_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_x (gfc_expr *);
 
 
@@ -221,14 +222,14 @@ gfc_expr *gfc_simplify_float (gfc_expr *);
 gfc_expr *gfc_simplify_floor (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_fraction (gfc_expr *);
 gfc_expr *gfc_simplify_huge (gfc_expr *);
-gfc_expr *gfc_simplify_iachar (gfc_expr *);
+gfc_expr *gfc_simplify_iachar (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_iand (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_ibclr (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_ibits (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_ibset (gfc_expr *, gfc_expr *);
-gfc_expr *gfc_simplify_ichar (gfc_expr *);
+gfc_expr *gfc_simplify_ichar (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_ieor (gfc_expr *, gfc_expr *);
-gfc_expr *gfc_simplify_index (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_int (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_int2 (gfc_expr *);
 gfc_expr *gfc_simplify_int8 (gfc_expr *);
@@ -239,9 +240,9 @@ gfc_expr *gfc_simplify_ior (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_ishft (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_ishftc (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_kind (gfc_expr *);
-gfc_expr *gfc_simplify_lbound (gfc_expr *, gfc_expr *);
-gfc_expr *gfc_simplify_len (gfc_expr *);
-gfc_expr *gfc_simplify_len_trim (gfc_expr *);
+gfc_expr *gfc_simplify_lbound (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_len (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_len_trim (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_lge (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_lgt (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_lle (gfc_expr *, gfc_expr *);
@@ -274,7 +275,7 @@ gfc_expr *gfc_simplify_reshape (gfc_expr *, gfc_expr *, gfc_expr *,
 				gfc_expr *);
 gfc_expr *gfc_simplify_rrspacing (gfc_expr *);
 gfc_expr *gfc_simplify_scale (gfc_expr *, gfc_expr *);
-gfc_expr *gfc_simplify_scan (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_selected_int_kind (gfc_expr *);
 gfc_expr *gfc_simplify_selected_real_kind (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_set_exponent (gfc_expr *, gfc_expr *);
@@ -282,7 +283,7 @@ gfc_expr *gfc_simplify_sign (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_shape (gfc_expr *);
 gfc_expr *gfc_simplify_sin (gfc_expr *);
 gfc_expr *gfc_simplify_sinh (gfc_expr *);
-gfc_expr *gfc_simplify_size (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_size (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_sngl (gfc_expr *);
 gfc_expr *gfc_simplify_spacing (gfc_expr *);
 gfc_expr *gfc_simplify_sqrt (gfc_expr *);
@@ -291,8 +292,8 @@ gfc_expr *gfc_simplify_tanh (gfc_expr *);
 gfc_expr *gfc_simplify_tiny (gfc_expr *);
 gfc_expr *gfc_simplify_transfer (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_trim (gfc_expr *);
-gfc_expr *gfc_simplify_ubound (gfc_expr *, gfc_expr *);
-gfc_expr *gfc_simplify_verify (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_ubound (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_xor (gfc_expr *, gfc_expr *);
 
 /* Constant conversion simplification.  */
@@ -330,7 +331,7 @@ void gfc_resolve_complex (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_conjg (gfc_expr *, gfc_expr *);
 void gfc_resolve_cos (gfc_expr *, gfc_expr *);
 void gfc_resolve_cosh (gfc_expr *, gfc_expr *);
-void gfc_resolve_count (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_count (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_cshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_ctime (gfc_expr *, gfc_expr *);
 void gfc_resolve_dble (gfc_expr *, gfc_expr *);
@@ -362,10 +363,12 @@ void gfc_resolve_iand (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_ibclr (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_ibits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_ibset (gfc_expr *, gfc_expr *, gfc_expr *);
-void gfc_resolve_index_func (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_index_func (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
+			     gfc_expr *);
 void gfc_resolve_ierrno (gfc_expr *);
 void gfc_resolve_ieor (gfc_expr *, gfc_expr *, gfc_expr *);
-void gfc_resolve_ichar (gfc_expr *, gfc_expr *);
+void gfc_resolve_ichar (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_iachar (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_idnint (gfc_expr *, gfc_expr *);
 void gfc_resolve_int (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_int2 (gfc_expr *, gfc_expr *);
@@ -378,9 +381,9 @@ void gfc_resolve_lshift (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_ishft (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_ishftc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_kill (gfc_expr *, gfc_expr *, gfc_expr *);
-void gfc_resolve_lbound (gfc_expr *, gfc_expr *, gfc_expr *);
-void gfc_resolve_len (gfc_expr *, gfc_expr *);
-void gfc_resolve_len_trim (gfc_expr *, gfc_expr *);
+void gfc_resolve_lbound (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_len (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_len_trim (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_link (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_loc (gfc_expr *, gfc_expr *);
 void gfc_resolve_log (gfc_expr *, gfc_expr *);
@@ -414,7 +417,8 @@ void gfc_resolve_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
 			  gfc_expr *);
 void gfc_resolve_rrspacing (gfc_expr *, gfc_expr *);
 void gfc_resolve_scale (gfc_expr *, gfc_expr *, gfc_expr *);
-void gfc_resolve_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
+		       gfc_expr *);
 void gfc_resolve_second_sub (gfc_code *);
 void gfc_resolve_secnds (gfc_expr *, gfc_expr *);
 void gfc_resolve_set_exponent (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -423,6 +427,7 @@ void gfc_resolve_sign (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_signal (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_sin (gfc_expr *, gfc_expr *);
 void gfc_resolve_sinh (gfc_expr *, gfc_expr *);
+void gfc_resolve_size (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_spacing (gfc_expr *, gfc_expr *);
 void gfc_resolve_spread (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_sqrt (gfc_expr *, gfc_expr *);
@@ -439,11 +444,12 @@ void gfc_resolve_transfer (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_transpose (gfc_expr *, gfc_expr *);
 void gfc_resolve_trim (gfc_expr *, gfc_expr *);
 void gfc_resolve_ttynam (gfc_expr *, gfc_expr *);
-void gfc_resolve_ubound (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_ubound (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_umask (gfc_expr *, gfc_expr *);
 void gfc_resolve_unlink (gfc_expr *, gfc_expr *);
 void gfc_resolve_unpack (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
-void gfc_resolve_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
+			 gfc_expr *);
 void gfc_resolve_xor (gfc_expr *, gfc_expr *, gfc_expr *);
 
 
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 14c746b59a7..f09246cc95e 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -2644,10 +2644,12 @@ Inverse function: @ref{ACOSH}
 
 @table @asis
 @item @emph{Description}:
-@code{COUNT(MASK [, DIM])} counts the number of @code{.TRUE.} elements of
-@var{MASK} along the dimension of @var{DIM}.  If @var{DIM} is omitted it is
-taken to be @code{1}.  @var{DIM} is a scaler of type @code{INTEGER} in the
-range of @math{1 /leq DIM /leq n)} where @math{n} is the rank of @var{MASK}.
+
+@code{COUNT(MASK [, DIM [, KIND]])} counts the number of @code{.TRUE.}
+elements of @var{MASK} along the dimension of @var{DIM}.  If @var{DIM} is
+omitted it is taken to be @code{1}.  @var{DIM} is a scaler of type
+@code{INTEGER} in the range of @math{1 /leq DIM /leq n)} where @math{n}
+is the rank of @var{MASK}.
 
 @item @emph{Standard}:
 F95 and later
@@ -2656,17 +2658,21 @@ F95 and later
 Transformational function
 
 @item @emph{Syntax}:
-@code{RESULT = COUNT(MASK [, DIM])}
+@code{RESULT = COUNT(MASK [, DIM [, KIND]])}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
 @item @var{MASK} @tab The type shall be @code{LOGICAL}.
-@item @var{DIM}  @tab The type shall be @code{INTEGER}.
+@item @var{DIM}  @tab (Optional) The type shall be @code{INTEGER}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+                      expression indicating the kind parameter of
+		      the result.
 @end multitable
 
 @item @emph{Return value}:
-The return value is of type @code{INTEGER} with rank equal to that of
-@var{MASK}.
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
+The result has a rank equal to that of @var{MASK}.
 
 @item @emph{Example}:
 @smallexample
@@ -5112,16 +5118,19 @@ F95 and later
 Elemental function
 
 @item @emph{Syntax}:
-@code{RESULT = IACHAR(C)}
+@code{RESULT = IACHAR(C [, KIND])}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{C} @tab Shall be a scalar @code{CHARACTER}, with @code{INTENT(IN)}
+@item @var{C}    @tab Shall be a scalar @code{CHARACTER}, with @code{INTENT(IN)}
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+                      expression indicating the kind parameter of
+		      the result.
 @end multitable
 
 @item @emph{Return value}:
-The return value is of type @code{INTEGER} and of the default integer
-kind.
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
 
 @item @emph{Example}:
 @smallexample
@@ -5366,16 +5375,19 @@ F95 and later
 Elemental function
 
 @item @emph{Syntax}:
-@code{RESULT = ICHAR(C)}
+@code{RESULT = ICHAR(C [, KIND])}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{C} @tab Shall be a scalar @code{CHARACTER}, with @code{INTENT(IN)}
+@item @var{C}    @tab Shall be a scalar @code{CHARACTER}, with @code{INTENT(IN)}
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+                      expression indicating the kind parameter of
+		      the result.
 @end multitable
 
 @item @emph{Return value}:
-The return value is of type @code{INTEGER} and of the default integer
-kind.
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
 
 @item @emph{Example}:
 @smallexample
@@ -5552,7 +5564,7 @@ F77 and later
 Elemental function
 
 @item @emph{Syntax}:
-@code{RESULT = INDEX(STRING, SUBSTRING [, BACK])}
+@code{RESULT = INDEX(STRING, SUBSTRING [, BACK [, KIND]])}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
@@ -5562,11 +5574,14 @@ Elemental function
 @code{INTENT(IN)}
 @item @var{BACK} @tab (Optional) Shall be a scalar @code{LOGICAL(*)}, with
 @code{INTENT(IN)}
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+                      expression indicating the kind parameter of
+		      the result.
 @end multitable
 
 @item @emph{Return value}:
-The return value is of type @code{INTEGER} and of the default integer
-kind.
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
 
 @item @emph{See also}:
 @ref{SCAN}, @ref{VERIFY}
@@ -6111,15 +6126,20 @@ F95 and later
 Inquiry function
 
 @item @emph{Syntax}:
-@code{RESULT = LBOUND(ARRAY [, DIM])}
+@code{RESULT = LBOUND(ARRAY [, DIM [, KIND]])}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
 @item @var{ARRAY} @tab Shall be an array, of any type.
 @item @var{DIM} @tab (Optional) Shall be a scalar @code{INTEGER(*)}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+                      expression indicating the kind parameter of
+		      the result.
 @end multitable
 
 @item @emph{Return value}:
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
 If @var{DIM} is absent, the result is an array of the lower bounds of
 @var{ARRAY}.  If @var{DIM} is present, the result is a scalar
 corresponding to the lower bound of the array along that dimension.  If
@@ -6152,16 +6172,20 @@ F77 and later
 Inquiry function
 
 @item @emph{Syntax}:
-@code{L = LEN(STRING)}
+@code{L = LEN(STRING [, KIND])}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
 @item @var{STRING} @tab Shall be a scalar or array of type
 @code{CHARACTER(*)}, with @code{INTENT(IN)}
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+                      expression indicating the kind parameter of
+		      the result.
 @end multitable
 
 @item @emph{Return value}:
-The return value is an @code{INTEGER} of the default kind.
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
 
 @item @emph{See also}:
 @ref{LEN_TRIM}, @ref{ADJUSTL}, @ref{ADJUSTR}
@@ -6185,16 +6209,20 @@ F95 and later
 Elemental function
 
 @item @emph{Syntax}:
-@code{RESULT = LEN_TRIM(STRING)}
+@code{RESULT = LEN_TRIM(STRING [, KIND])}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
 @item @var{STRING} @tab Shall be a scalar of type @code{CHARACTER(*)},
 with @code{INTENT(IN)}
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+                      expression indicating the kind parameter of
+		      the result.
 @end multitable
 
 @item @emph{Return value}:
-The return value is an @code{INTEGER} of the default kind.
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
 
 @item @emph{See also}:
 @ref{LEN}, @ref{ADJUSTL}, @ref{ADJUSTR}
@@ -8788,18 +8816,21 @@ F95 and later
 Elemental function
 
 @item @emph{Syntax}:
-@code{RESULT = SCAN(STRING, SET[, BACK])}
+@code{RESULT = SCAN(STRING, SET[, BACK [, KIND]])}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
 @item @var{STRING} @tab Shall be of type @code{CHARACTER(*)}.
 @item @var{SET}    @tab Shall be of type @code{CHARACTER(*)}.
 @item @var{BACK}   @tab (Optional) shall be of type @code{LOGICAL}.
+@item @var{KIND}   @tab (Optional) An @code{INTEGER} initialization
+                        expression indicating the kind parameter of
+		      the result.
 @end multitable
 
 @item @emph{Return value}:
-The return value is of type @code{INTEGER} and of the default
-integer kind.
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
 
 @item @emph{Example}:
 @smallexample
@@ -9342,7 +9373,7 @@ F95 and later
 Inquiry function
 
 @item @emph{Syntax}:
-@code{RESULT = SIZE(ARRAY[, DIM])}
+@code{RESULT = SIZE(ARRAY[, DIM [, KIND]])}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
@@ -9351,11 +9382,14 @@ a pointer it must be associated and allocatable arrays must be allocated.
 @item @var{DIM}   @tab (Optional) shall be a scalar of type @code{INTEGER} 
 and its value shall be in the range from 1 to n, where n equals the rank 
 of @var{ARRAY}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+                      expression indicating the kind parameter of
+		      the result.
 @end multitable
 
 @item @emph{Return value}:
-The return value is of type @code{INTEGER} and of the default
-integer kind.
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
 
 @item @emph{Example}:
 @smallexample
@@ -10367,15 +10401,20 @@ F95 and later
 Inquiry function
 
 @item @emph{Syntax}:
-@code{RESULT = UBOUND(ARRAY [, DIM])}
+@code{RESULT = UBOUND(ARRAY [, DIM [, KIND]])}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
 @item @var{ARRAY} @tab Shall be an array, of any type.
 @item @var{DIM} @tab (Optional) Shall be a scalar @code{INTEGER(*)}.
+@item @var{KIND}@tab (Optional) An @code{INTEGER} initialization
+                     expression indicating the kind parameter of
+		     the result.
 @end multitable
 
 @item @emph{Return value}:
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
 If @var{DIM} is absent, the result is an array of the upper bounds of
 @var{ARRAY}.  If @var{DIM} is present, the result is a scalar
 corresponding to the upper bound of the array along that dimension.  If
@@ -10533,18 +10572,21 @@ F95 and later
 Elemental function
 
 @item @emph{Syntax}:
-@code{RESULT = VERIFY(STRING, SET[, BACK])}
+@code{RESULT = VERIFY(STRING, SET[, BACK [, KIND]])}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
 @item @var{STRING} @tab Shall be of type @code{CHARACTER(*)}.
 @item @var{SET}    @tab Shall be of type @code{CHARACTER(*)}.
 @item @var{BACK}   @tab (Optional) shall be of type @code{LOGICAL}.
+@item @var{KIND}   @tab (Optional) An @code{INTEGER} initialization
+                        expression indicating the kind parameter of
+		        the result.
 @end multitable
 
 @item @emph{Return value}:
-The return value is of type @code{INTEGER} and of the default
-integer kind.
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
 
 @item @emph{Example}:
 @smallexample
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index d0a73bfc8f2..e3186155f27 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -520,10 +520,13 @@ gfc_resolve_cosh (gfc_expr *f, gfc_expr *x)
 
 
 void
-gfc_resolve_count (gfc_expr *f, gfc_expr *mask, gfc_expr *dim)
+gfc_resolve_count (gfc_expr *f, gfc_expr *mask, gfc_expr *dim, gfc_expr *kind)
 {
   f->ts.type = BT_INTEGER;
-  f->ts.kind = gfc_default_integer_kind;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
 
   if (dim != NULL)
     {
@@ -856,10 +859,25 @@ gfc_resolve_ibset (gfc_expr *f, gfc_expr *i, gfc_expr *pos ATTRIBUTE_UNUSED)
 
 
 void
-gfc_resolve_ichar (gfc_expr *f, gfc_expr *c)
+gfc_resolve_iachar (gfc_expr *f, gfc_expr *c, gfc_expr *kind)
 {
   f->ts.type = BT_INTEGER;
-  f->ts.kind = gfc_default_integer_kind;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = gfc_get_string ("__ichar_%d", c->ts.kind);
+}
+
+
+void
+gfc_resolve_ichar (gfc_expr *f, gfc_expr *c, gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
   f->value.function.name = gfc_get_string ("__ichar_%d", c->ts.kind);
 }
 
@@ -920,12 +938,16 @@ gfc_resolve_ior (gfc_expr *f, gfc_expr *i, gfc_expr *j)
 
 void
 gfc_resolve_index_func (gfc_expr *f, gfc_expr *str,
-			gfc_expr *sub_str ATTRIBUTE_UNUSED, gfc_expr *back)
+			gfc_expr *sub_str ATTRIBUTE_UNUSED, gfc_expr *back,
+			gfc_expr *kind)
 {
   gfc_typespec ts;
 
   f->ts.type = BT_INTEGER;
-  f->ts.kind = gfc_default_integer_kind;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
 
   if (back && back->ts.kind != gfc_default_integer_kind)
     {
@@ -1057,12 +1079,15 @@ gfc_resolve_kill (gfc_expr *f, gfc_expr *p ATTRIBUTE_UNUSED,
 
 
 void
-gfc_resolve_lbound (gfc_expr *f, gfc_expr *array, gfc_expr *dim)
+gfc_resolve_lbound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 {
   static char lbound[] = "__lbound";
 
   f->ts.type = BT_INTEGER;
-  f->ts.kind = gfc_default_integer_kind;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
 
   if (dim == NULL)
     {
@@ -1076,10 +1101,13 @@ gfc_resolve_lbound (gfc_expr *f, gfc_expr *array, gfc_expr *dim)
 
 
 void
-gfc_resolve_len (gfc_expr *f, gfc_expr *string)
+gfc_resolve_len (gfc_expr *f, gfc_expr *string, gfc_expr *kind)
 {
   f->ts.type = BT_INTEGER;
-  f->ts.kind = gfc_default_integer_kind;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
   f->value.function.name
     = gfc_get_string ("__len_%d_i%d", string->ts.kind,
 		      gfc_default_integer_kind);
@@ -1087,10 +1115,13 @@ gfc_resolve_len (gfc_expr *f, gfc_expr *string)
 
 
 void
-gfc_resolve_len_trim (gfc_expr *f, gfc_expr *string)
+gfc_resolve_len_trim (gfc_expr *f, gfc_expr *string, gfc_expr *kind)
 {
   f->ts.type = BT_INTEGER;
-  f->ts.kind = gfc_default_integer_kind;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
   f->value.function.name = gfc_get_string ("__len_trim%d", string->ts.kind);
 }
 
@@ -1776,10 +1807,13 @@ gfc_resolve_scale (gfc_expr *f, gfc_expr *x, gfc_expr *i)
 void
 gfc_resolve_scan (gfc_expr *f, gfc_expr *string,
 		  gfc_expr *set ATTRIBUTE_UNUSED,
-		  gfc_expr *back ATTRIBUTE_UNUSED)
+		  gfc_expr *back ATTRIBUTE_UNUSED, gfc_expr *kind)
 {
   f->ts.type = BT_INTEGER;
-  f->ts.kind = gfc_default_integer_kind;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
   f->value.function.name = gfc_get_string ("__scan_%d", string->ts.kind);
 }
 
@@ -1873,6 +1907,18 @@ gfc_resolve_sinh (gfc_expr *f, gfc_expr *x)
 
 
 void
+gfc_resolve_size (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
+		  gfc_expr *dim ATTRIBUTE_UNUSED, gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
+}
+
+
+void
 gfc_resolve_spacing (gfc_expr *f, gfc_expr *x)
 {
   int k; 
@@ -2265,12 +2311,15 @@ gfc_resolve_trim (gfc_expr *f, gfc_expr *string)
 
 
 void
-gfc_resolve_ubound (gfc_expr *f, gfc_expr *array, gfc_expr *dim)
+gfc_resolve_ubound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 {
   static char ubound[] = "__ubound";
 
   f->ts.type = BT_INTEGER;
-  f->ts.kind = gfc_default_integer_kind;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
 
   if (dim == NULL)
     {
@@ -2343,10 +2392,13 @@ gfc_resolve_unpack (gfc_expr *f, gfc_expr *vector, gfc_expr *mask,
 void
 gfc_resolve_verify (gfc_expr *f, gfc_expr *string,
 		    gfc_expr *set ATTRIBUTE_UNUSED,
-		    gfc_expr *back ATTRIBUTE_UNUSED)
+		    gfc_expr *back ATTRIBUTE_UNUSED, gfc_expr *kind)
 {
   f->ts.type = BT_INTEGER;
-  f->ts.kind = gfc_default_integer_kind;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
   f->value.function.name = gfc_get_string ("__verify_%d", string->ts.kind);
 }
 
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 88a146bd18f..c3c23cb9215 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -115,14 +115,12 @@ get_kind (bt type, gfc_expr *k, const char *name, int default_kind)
     {
       gfc_error ("KIND parameter of %s at %L must be an initialization "
 		 "expression", name, &k->where);
-
       return -1;
     }
 
   if (gfc_extract_int (k, &kind) != NULL
       || gfc_validate_kind (type, kind, true) < 0)
     {
-
       gfc_error ("Invalid KIND parameter of %s at %L", name, &k->where);
       return -1;
     }
@@ -131,6 +129,20 @@ get_kind (bt type, gfc_expr *k, const char *name, int default_kind)
 }
 
 
+/* Helper function to get an integer constant with a kind number given
+   by an integer constant expression.  */
+static gfc_expr *
+int_expr_with_kind (int i, gfc_expr *kind, const char *name)
+{
+  gfc_expr *res = gfc_int_expr (i);
+  res->ts.kind = get_kind (BT_INTEGER, kind, name, gfc_default_integer_kind); 
+  if (res->ts.kind == -1)
+    return NULL;
+  else
+    return res;
+}
+
+
 /* Converts an mpz_t signed variable into an unsigned one, assuming
    two's complement representations and a binary width of bitsize.
    The conversion is a no-op unless x is negative; otherwise, it can
@@ -1198,7 +1210,7 @@ gfc_simplify_huge (gfc_expr *e)
    systems that gfortran currently works on are ASCII.  */
 
 gfc_expr *
-gfc_simplify_iachar (gfc_expr *e)
+gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind)
 {
   gfc_expr *result;
   int index;
@@ -1218,7 +1230,9 @@ gfc_simplify_iachar (gfc_expr *e)
     gfc_warning ("Argument of IACHAR function at %L outside of range 0..127",
 		 &e->where);
 
-  result = gfc_int_expr (index);
+  if ((result = int_expr_with_kind (index, kind, "IACHAR")) == NULL)
+    return &gfc_bad_expr;
+
   result->where = e->where;
 
   return range_check (result, "IACHAR");
@@ -1380,7 +1394,7 @@ gfc_simplify_ibset (gfc_expr *x, gfc_expr *y)
 
 
 gfc_expr *
-gfc_simplify_ichar (gfc_expr *e)
+gfc_simplify_ichar (gfc_expr *e, gfc_expr *kind)
 {
   gfc_expr *result;
   int index;
@@ -1399,7 +1413,9 @@ gfc_simplify_ichar (gfc_expr *e)
   if (index < 0 || index > UCHAR_MAX)
     gfc_internal_error("Argument of ICHAR at %L out of range", &e->where);
 
-  result = gfc_int_expr (index);
+  if ((result = int_expr_with_kind (index, kind, "ICHAR")) == NULL)
+    return &gfc_bad_expr;
+
   result->where = e->where;
   return range_check (result, "ICHAR");
 }
@@ -1422,7 +1438,7 @@ gfc_simplify_ieor (gfc_expr *x, gfc_expr *y)
 
 
 gfc_expr *
-gfc_simplify_index (gfc_expr *x, gfc_expr *y, gfc_expr *b)
+gfc_simplify_index (gfc_expr *x, gfc_expr *y, gfc_expr *b, gfc_expr *kind)
 {
   gfc_expr *result;
   int back, len, lensub;
@@ -1436,8 +1452,11 @@ gfc_simplify_index (gfc_expr *x, gfc_expr *y, gfc_expr *b)
   else
     back = 0;
 
-  result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
-				&x->where);
+  k = get_kind (BT_INTEGER, kind, "INDEX", gfc_default_integer_kind); 
+  if (k == -1)
+    return &gfc_bad_expr;
+
+  result = gfc_constant_result (BT_INTEGER, k, &x->where);
 
   len = x->value.character.length;
   lensub = y->value.character.length;
@@ -1938,9 +1957,11 @@ gfc_simplify_kind (gfc_expr *e)
 
 
 static gfc_expr *
-simplify_bound_dim (gfc_expr *array, int d, int upper, gfc_array_spec *as)
+simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper,
+		    gfc_array_spec *as)
 {
   gfc_expr *l, *u, *result;
+  int k;
 
   /* The last dimension of an assumed-size array is special.  */
   if (d == as->rank && as->type == AS_ASSUMED_SIZE && !upper)
@@ -1958,8 +1979,12 @@ simplify_bound_dim (gfc_expr *array, int d, int upper, gfc_array_spec *as)
   if (l->expr_type != EXPR_CONSTANT || u->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
-				&array->where);
+  k = get_kind (BT_INTEGER, kind, upper ? "UBOUND" : "LBOUND",
+		gfc_default_integer_kind); 
+  if (k == -1)
+    return &gfc_bad_expr;
+
+  result = gfc_constant_result (BT_INTEGER, k, &array->where);
 
   if (mpz_cmp (l->value.integer, u->value.integer) > 0)
     {
@@ -1983,7 +2008,7 @@ simplify_bound_dim (gfc_expr *array, int d, int upper, gfc_array_spec *as)
 
 
 static gfc_expr *
-simplify_bound (gfc_expr *array, gfc_expr *dim, int upper)
+simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
 {
   gfc_ref *ref;
   gfc_array_spec *as;
@@ -2039,6 +2064,7 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, int upper)
       gfc_expr *bounds[GFC_MAX_DIMENSIONS];
       gfc_expr *e;
       gfc_constructor *head, *tail;
+      int k;
 
       /* UBOUND(ARRAY) is not valid for an assumed-size array.  */
       if (upper && as->type == AS_ASSUMED_SIZE)
@@ -2051,7 +2077,7 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, int upper)
       /* Simplify the bounds for each dimension.  */
       for (d = 0; d < array->rank; d++)
 	{
-	  bounds[d] = simplify_bound_dim (array, d + 1, upper, as);
+	  bounds[d] = simplify_bound_dim (array, kind, d + 1, upper, as);
 	  if (bounds[d] == NULL || bounds[d] == &gfc_bad_expr)
 	    {
 	      int j;
@@ -2067,7 +2093,11 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, int upper)
       e->where = array->where;
       e->expr_type = EXPR_ARRAY;
       e->ts.type = BT_INTEGER;
-      e->ts.kind = gfc_default_integer_kind;
+      k = get_kind (BT_INTEGER, kind, upper ? "UBOUND" : "LBOUND",
+		    gfc_default_integer_kind); 
+      if (k == -1)
+	return &gfc_bad_expr;
+      e->ts.kind = k;
 
       /* The result is a rank 1 array; its size is the rank of the first
 	 argument to {L,U}BOUND.  */
@@ -2110,27 +2140,30 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, int upper)
 	  return &gfc_bad_expr;
 	}
 
-      return simplify_bound_dim (array, d, upper, as);
+      return simplify_bound_dim (array, kind, d, upper, as);
     }
 }
 
 
 gfc_expr *
-gfc_simplify_lbound (gfc_expr *array, gfc_expr *dim)
+gfc_simplify_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 {
-  return simplify_bound (array, dim, 0);
+  return simplify_bound (array, dim, kind, 0);
 }
 
 
 gfc_expr *
-gfc_simplify_len (gfc_expr *e)
+gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
 {
   gfc_expr *result;
+  int k = get_kind (BT_INTEGER, kind, "LEN", gfc_default_integer_kind);
+
+  if (k == -1)
+    return &gfc_bad_expr;
 
   if (e->expr_type == EXPR_CONSTANT)
     {
-      result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
-				    &e->where);
+      result = gfc_constant_result (BT_INTEGER, k, &e->where);
       mpz_set_si (result->value.integer, e->value.character.length);
       return range_check (result, "LEN");
     }
@@ -2139,8 +2172,7 @@ gfc_simplify_len (gfc_expr *e)
       && e->ts.cl->length->expr_type == EXPR_CONSTANT
       && e->ts.cl->length->ts.type == BT_INTEGER)
     {
-      result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
-				    &e->where);
+      result = gfc_constant_result (BT_INTEGER, k, &e->where);
       mpz_set (result->value.integer, e->ts.cl->length->value.integer);
       return range_check (result, "LEN");
     }
@@ -2150,17 +2182,19 @@ gfc_simplify_len (gfc_expr *e)
 
 
 gfc_expr *
-gfc_simplify_len_trim (gfc_expr *e)
+gfc_simplify_len_trim (gfc_expr *e, gfc_expr *kind)
 {
   gfc_expr *result;
   int count, len, lentrim, i;
+  int k = get_kind (BT_INTEGER, kind, "LEN_TRIM", gfc_default_integer_kind);
+
+  if (k == -1)
+    return &gfc_bad_expr;
 
   if (e->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
-				&e->where);
-
+  result = gfc_constant_result (BT_INTEGER, k, &e->where);
   len = e->value.character.length;
 
   for (count = 0, i = 1; i <= len; i++)
@@ -3323,12 +3357,16 @@ gfc_simplify_scale (gfc_expr *x, gfc_expr *i)
 
 
 gfc_expr *
-gfc_simplify_scan (gfc_expr *e, gfc_expr *c, gfc_expr *b)
+gfc_simplify_scan (gfc_expr *e, gfc_expr *c, gfc_expr *b, gfc_expr *kind)
 {
   gfc_expr *result;
   int back;
   size_t i;
   size_t indx, len, lenc;
+  int k = get_kind (BT_INTEGER, kind, "SCAN", gfc_default_integer_kind);
+
+  if (k == -1)
+    return &gfc_bad_expr;
 
   if (e->expr_type != EXPR_CONSTANT || c->expr_type != EXPR_CONSTANT)
     return NULL;
@@ -3338,8 +3376,7 @@ gfc_simplify_scan (gfc_expr *e, gfc_expr *c, gfc_expr *b)
   else
     back = 0;
 
-  result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
-				&e->where);
+  result = gfc_constant_result (BT_INTEGER, k, &e->where);
 
   len = e->value.character.length;
   lenc = c->value.character.length;
@@ -3545,7 +3582,7 @@ gfc_simplify_shape (gfc_expr *source)
 	{
 	  mpz_set_ui (e->value.integer, n + 1);
 
-	  f = gfc_simplify_size (source, e);
+	  f = gfc_simplify_size (source, e, NULL);
 	  gfc_free_expr (e);
 	  if (f == NULL)
 	    {
@@ -3566,11 +3603,15 @@ gfc_simplify_shape (gfc_expr *source)
 
 
 gfc_expr *
-gfc_simplify_size (gfc_expr *array, gfc_expr *dim)
+gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 {
   mpz_t size;
   gfc_expr *result;
   int d;
+  int k = get_kind (BT_INTEGER, kind, "SCAN", gfc_default_integer_kind);
+
+  if (k == -1)
+    return &gfc_bad_expr;
 
   if (dim == NULL)
     {
@@ -3587,11 +3628,8 @@ gfc_simplify_size (gfc_expr *array, gfc_expr *dim)
 	return NULL;
     }
 
-  result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
-				&array->where);
-
+  result = gfc_constant_result (BT_INTEGER, k, &array->where);
   mpz_set (result->value.integer, size);
-
   return result;
 }
 
@@ -4028,19 +4066,23 @@ gfc_simplify_trim (gfc_expr *e)
 
 
 gfc_expr *
-gfc_simplify_ubound (gfc_expr *array, gfc_expr *dim)
+gfc_simplify_ubound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 {
-  return simplify_bound (array, dim, 1);
+  return simplify_bound (array, dim, kind, 1);
 }
 
 
 gfc_expr *
-gfc_simplify_verify (gfc_expr *s, gfc_expr *set, gfc_expr *b)
+gfc_simplify_verify (gfc_expr *s, gfc_expr *set, gfc_expr *b, gfc_expr *kind)
 {
   gfc_expr *result;
   int back;
   size_t index, len, lenset;
   size_t i;
+  int k = get_kind (BT_INTEGER, kind, "VERIFY", gfc_default_integer_kind);
+
+  if (k == -1)
+    return &gfc_bad_expr;
 
   if (s->expr_type != EXPR_CONSTANT || set->expr_type != EXPR_CONSTANT)
     return NULL;
@@ -4050,8 +4092,7 @@ gfc_simplify_verify (gfc_expr *s, gfc_expr *set, gfc_expr *b)
   else
     back = 0;
 
-  result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
-				&s->where);
+  result = gfc_constant_result (BT_INTEGER, k, &s->where);
 
   len = s->value.character.length;
   lenset = set->value.character.length;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 4b0902f62d6..e9b94802190 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1109,9 +1109,14 @@ gfc_get_extern_function_decl (gfc_symbol * sym)
 	    isym->resolve.f2 (&e, &argexpr, NULL);
 	  else
 	    {
-	      /* All specific intrinsics take less than 4 arguments.  */
-	      gcc_assert (isym->formal->next->next->next == NULL);
-	      isym->resolve.f3 (&e, &argexpr, NULL, NULL);
+	      if (isym->formal->next->next->next == NULL)
+		isym->resolve.f3 (&e, &argexpr, NULL, NULL);
+	      else
+		{
+		  /* All specific intrinsics take less than 5 arguments.  */
+		  gcc_assert (isym->formal->next->next->next->next == NULL);
+		  isym->resolve.f4 (&e, &argexpr, NULL, NULL, NULL);
+		}
 	    }
 	}
 
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index b9dbf464c46..c8e16462aa8 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2759,7 +2759,8 @@ gfc_conv_intrinsic_len_trim (gfc_se * se, gfc_expr * expr)
 /* Returns the starting position of a substring within a string.  */
 
 static void
-gfc_conv_intrinsic_index (gfc_se * se, gfc_expr * expr)
+gfc_conv_intrinsic_index_scan_verify (gfc_se * se, gfc_expr * expr,
+				      tree function)
 {
   tree logical4_type_node = gfc_get_logical_type (4);
   tree type;
@@ -2770,20 +2771,18 @@ gfc_conv_intrinsic_index (gfc_se * se, gfc_expr * expr)
   num_args = gfc_intrinsic_argument_list_length (expr);
   args = alloca (sizeof (tree) * 5);
 
-  gfc_conv_intrinsic_function_args (se, expr, args, num_args);
+  gfc_conv_intrinsic_function_args (se, expr, args,
+				    num_args >= 5 ? 5 : num_args);
   type = gfc_typenode_for_spec (&expr->ts);
 
   if (num_args == 4)
     args[4] = build_int_cst (logical4_type_node, 0);
   else
-    {
-      gcc_assert (num_args == 5);
-      args[4] = convert (logical4_type_node, args[4]);
-    }
+    args[4] = convert (logical4_type_node, args[4]);
 
-  fndecl = build_addr (gfor_fndecl_string_index, current_function_decl);
-  se->expr = build_call_array (TREE_TYPE (TREE_TYPE (gfor_fndecl_string_index)),
-			       fndecl, 5, args);
+  fndecl = build_addr (function, current_function_decl);
+  se->expr = build_call_array (TREE_TYPE (TREE_TYPE (function)), fndecl,
+			       5, args);
   se->expr = convert (type, se->expr);
 
 }
@@ -3471,73 +3470,6 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
 }
 
 
-/* Scan a string for any one of the characters in a set of characters.  */
-
-static void
-gfc_conv_intrinsic_scan (gfc_se * se, gfc_expr * expr)
-{
-  tree logical4_type_node = gfc_get_logical_type (4);
-  tree type;
-  tree fndecl;
-  tree *args;
-  unsigned int num_args;
-
-  num_args = gfc_intrinsic_argument_list_length (expr);
-  args = alloca (sizeof (tree) * 5);
-
-  gfc_conv_intrinsic_function_args (se, expr, args, num_args);
-  type = gfc_typenode_for_spec (&expr->ts);
-
-  if (num_args == 4)
-    args[4] = build_int_cst (logical4_type_node, 0);
-  else
-    {
-      gcc_assert (num_args == 5);
-      args[4] = convert (logical4_type_node, args[4]);
-    }
-
-  fndecl = build_addr (gfor_fndecl_string_scan, current_function_decl);
-  se->expr = build_call_array (TREE_TYPE (TREE_TYPE (gfor_fndecl_string_scan)),
-			       fndecl, 5, args);
-  se->expr = convert (type, se->expr);
-}
-
-
-/* Verify that a set of characters contains all the characters in a string
-   by identifying the position of the first character in a string of
-   characters that does not appear in a given set of characters.  */
-
-static void
-gfc_conv_intrinsic_verify (gfc_se * se, gfc_expr * expr)
-{
-  tree logical4_type_node = gfc_get_logical_type (4);
-  tree type;
-  tree fndecl;
-  tree *args;
-  unsigned int num_args;
-
-  num_args = gfc_intrinsic_argument_list_length (expr);
-  args = alloca (sizeof (tree) * 5);
-
-  gfc_conv_intrinsic_function_args (se, expr, args, num_args);
-  type = gfc_typenode_for_spec (&expr->ts);
-
-  if (num_args == 4)
-    args[4] = build_int_cst (logical4_type_node, 0);
-  else
-    {
-      gcc_assert (num_args == 5);
-      args[4] = convert (logical4_type_node, args[4]);
-    }
-
-  fndecl = build_addr (gfor_fndecl_string_verify, current_function_decl);
-  se->expr = build_call_array (TREE_TYPE (TREE_TYPE (gfor_fndecl_string_verify)),
-			       fndecl, 5, args);
-
-  se->expr = convert (type, se->expr);
-}
-
-
 /* Generate code for SELECTED_INT_KIND (R) intrinsic function.  */
 
 static void
@@ -3862,11 +3794,11 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       break;
 
     case GFC_ISYM_SCAN:
-      gfc_conv_intrinsic_scan (se, expr);
+      gfc_conv_intrinsic_index_scan_verify (se, expr, gfor_fndecl_string_scan);
       break;
 
     case GFC_ISYM_VERIFY:
-      gfc_conv_intrinsic_verify (se, expr);
+      gfc_conv_intrinsic_index_scan_verify (se, expr, gfor_fndecl_string_verify);
       break;
 
     case GFC_ISYM_ALLOCATED:
@@ -4029,7 +3961,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       break;
 
     case GFC_ISYM_INDEX:
-      gfc_conv_intrinsic_index (se, expr);
+      gfc_conv_intrinsic_index_scan_verify (se, expr, gfor_fndecl_string_index);
       break;
 
     case GFC_ISYM_IOR: