* intrinsic.c (add_functions): Add SELECTED_CHAR_KIND intrinsic.

	* intrinsic.h (gfc_check_selected_char_kind,
	gfc_simplify_selected_char_kind): New prototypes.
	* gfortran.h (gfc_isym_id): Add GFC_ISYM_SC_KIND.
	* trans.h (gfor_fndecl_sc_kind): New function decl.
	* trans-decl.c (gfor_fndecl_sc_kind): Build new decl.
	* arith.c (gfc_compare_with_Cstring): New function.
	* arith.h (gfc_compare_with_Cstring): New prototype.
	* check.c (gfc_check_selected_char_kind): New function.
	* primary.c (match_string_constant, match_kind_param): Mark
	symbols used as literal constant kind param as referenced.
	* trans-intrinsic.c (gfc_conv_intrinsic_sc_kind): New function.
	(gfc_conv_intrinsic_function): Call gfc_conv_intrinsic_sc_kind.
	* intrinsic.texi (SELECTED_CHAR_KIND): Document new intrinsic.
	* simplify.c (gfc_simplify_selected_char_kind): New function.

	* intrinsics/selected_char_kind.c: New file.
	* Makefile.am: Add intrinsics/selected_char_kind.c.
	* Makefile.in: Regenerate.

	* gfortran.dg/selected_char_kind_1.f90: New test.
	* gfortran.dg/selected_char_kind_2.f90: New test.
	* gfortran.dg/selected_char_kind_3.f90: New test.


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

1 files changed, 34 insertions, 1 deletions

diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index fdd6f6a7d77..4b8d45b189b 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -1208,7 +1208,7 @@ gfc_compare_string (gfc_expr *a, gfc_expr *b)
   alen = a->value.character.length;
   blen = b->value.character.length;
 
-  len = (alen > blen) ? alen : blen;
+  len = MAX(alen, blen);
 
   for (i = 0; i < len; i++)
     {
@@ -1224,7 +1224,40 @@ gfc_compare_string (gfc_expr *a, gfc_expr *b)
     }
 
   /* Strings are equal */
+  return 0;
+}
+
+
+int
+gfc_compare_with_Cstring (gfc_expr *a, const char *b, bool case_sensitive)
+{
+  int len, alen, blen, i, ac, bc;
+
+  alen = a->value.character.length;
+  blen = strlen (b);
+
+  len = MAX(alen, blen);
+
+  for (i = 0; i < len; i++)
+    {
+      /* We cast to unsigned char because default char, if it is signed,
+	 would lead to ac < 0 for string[i] > 127.  */
+      ac = (unsigned char) ((i < alen) ? a->value.character.string[i] : ' ');
+      bc = (unsigned char) ((i < blen) ? b[i] : ' ');
 
+      if (!case_sensitive)
+	{
+	  ac = TOLOWER (ac);
+	  bc = TOLOWER (bc);
+	}
+
+      if (ac < bc)
+	return -1;
+      if (ac > bc)
+	return 1;
+    }
+
+  /* Strings are equal */
   return 0;
 }