* arith.c: (gfc_arith_concat, gfc_compare_string,

	gfc_compare_with_Cstring, hollerith2representation,
	gfc_hollerith2int, gfc_hollerith2real, gfc_hollerith2complex,
	gfc_hollerith2character, gfc_hollerith2logical): Use wide
	characters for character constants.
	* data.c (create_character_intializer): Likewise.
	* decl.c (gfc_set_constant_character_len): Likewise.
	* dump-parse-tree.c (show_char_const): Correctly dump wide
	character strings.
	error.c (print_wide_char): Rename into gfc_print_wide_char.
	(show_locus): Adapt to new prototype of gfc_print_wide_char.
	expr.c (free_expr0): Representation is now disjunct from
	character string value, so we always free it.
	(gfc_copy_expr, find_substring_ref, gfc_simplify_expr): Adapt
	to wide character strings.
	* gfortran.h (gfc_expr): Make value.character.string a wide string.
	(gfc_wide_toupper, gfc_wide_strncasecmp, gfc_wide_memset,
	gfc_widechar_to_char, gfc_char_to_widechar): New prototypes.
	(gfc_get_wide_string): New macro.
	(gfc_print_wide_char): New prototype.
	* io.c (format_string): Make a wide string.
	(next_char, gfc_match_format, compare_to_allowed_values, 
	gfc_match_open): Deal with wide strings.
	* module.c (mio_expr): Convert between wide strings and ASCII ones.
	* primary.c (match_hollerith_constant, match_charkind_name): 
	Handle wide strings.
	* resolve.c (build_default_init_expr): Likewise.
	* scanner.c (gfc_wide_toupper, gfc_wide_memset,
	gfc_char_to_widechar): New functions.
	(wide_strchr, gfc_widechar_to_char, gfc_wide_strncasecmp):
	Changes in prototypes.
	(gfc_define_undef_line, load_line, preprocessor_line,
	include_line, load_file, gfc_read_orig_filename): Handle wide
	strings.
	* simplify.c (gfc_simplify_achar, gfc_simplify_adjustl,
	gfc_simplify_adjustr, gfc_simplify_char, gfc_simplify_iachar,
	gfc_simplify_ichar, simplify_min_max, gfc_simplify_new_line,
	gfc_simplify_repeat): Handle wide strings.
	(wide_strspn, wide_strcspn): New helper functions.
	(gfc_simplify_scan, gfc_simplify_trim, gfc_simplify_verify):
	Handle wide strings.
	* symbol.c (generate_isocbinding_symbol): Likewise.
	* target-memory.c (size_character, gfc_target_expr_size,
	encode_character, gfc_target_encode_expr, gfc_interpret_character,
	gfc_target_interpret_expr): Handle wide strings.
	* trans-const.c (gfc_conv_string_init): Lower wide strings to
	narrow ones.
	(gfc_conv_constant_to_tree): Likewise.
	* trans-expr.c (gfc_conv_substring_expr): Handle wide strings.
	* trans-io.c (gfc_new_nml_name_expr): Likewise.
	* trans-stmt.c (gfc_trans_label_assign): Likewise.


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

1 files changed, 33 insertions, 16 deletions

diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index e16c163ceaa..149afa1e8ca 100644
--- a/gcc/fortran/target-memory.c
+++ b/gcc/fortran/target-memory.c
@@ -73,9 +73,9 @@ size_logical (int kind)
 
 
 static size_t
-size_character (int length)
+size_character (int length, int kind)
 {
-  return length;
+  return length * kind;
 }
 
 
@@ -100,7 +100,7 @@ gfc_target_expr_size (gfc_expr *e)
     case BT_LOGICAL:
       return size_logical (e->ts.kind);
     case BT_CHARACTER:
-      return size_character (e->value.character.length);
+      return size_character (e->value.character.length, e->ts.kind);
     case BT_HOLLERITH:
       return e->representation.length;
     case BT_DERIVED:
@@ -174,11 +174,20 @@ encode_logical (int kind, int logical, unsigned char *buffer, size_t buffer_size
 
 
 static int
-encode_character (int length, char *string, unsigned char *buffer,
-		  size_t buffer_size)
+encode_character (int kind, int length, gfc_char_t *string,
+		  unsigned char *buffer, size_t buffer_size)
 {
-  gcc_assert (buffer_size >= size_character (length));
-  memcpy (buffer, string, length);
+  char *s;
+
+  gcc_assert (buffer_size >= size_character (length, kind));
+  /* FIXME -- when we support wide character types, we'll need to go
+     via integers for them.  For now, we keep the simple memcpy().  */
+  gcc_assert (kind == gfc_default_character_kind);
+
+  s = gfc_widechar_to_char (string, length);
+  memcpy (buffer, s, length);
+  gfc_free (s);
+
   return length;
 }
 
@@ -248,7 +257,7 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
       return encode_logical (source->ts.kind, source->value.logical, buffer,
 			     buffer_size);
     case BT_CHARACTER:
-      return encode_character (source->value.character.length, 
+      return encode_character (source->ts.kind, source->value.character.length,
 			       source->value.character.string, buffer,
 			       buffer_size);
     case BT_DERIVED:
@@ -351,18 +360,24 @@ gfc_interpret_logical (int kind, unsigned char *buffer, size_t buffer_size,
 
 
 int
-gfc_interpret_character (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
+gfc_interpret_character (unsigned char *buffer, size_t buffer_size,
+			 gfc_expr *result)
 {
+  int i;
+
   if (result->ts.cl && result->ts.cl->length)
     result->value.character.length =
-      (int)mpz_get_ui (result->ts.cl->length->value.integer);
+      (int) mpz_get_ui (result->ts.cl->length->value.integer);
 
-  gcc_assert (buffer_size >= size_character (result->value.character.length));
+  gcc_assert (buffer_size >= size_character (result->value.character.length,
+					     result->ts.kind));
   result->value.character.string =
-    gfc_getmem (result->value.character.length + 1);
-  memcpy (result->value.character.string, buffer,
-	  result->value.character.length);
-  result->value.character.string [result->value.character.length] = '\0';
+    gfc_get_wide_string (result->value.character.length + 1);
+
+  gcc_assert (result->ts.kind == gfc_default_character_kind);
+  for (i = 0; i < result->value.character.length; i++)
+    result->value.character.string[i] = (gfc_char_t) buffer[i];
+  result->value.character.string[result->value.character.length] = '\0';
 
   return result->value.character.length;
 }
@@ -481,7 +496,9 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
     }
 
   if (result->ts.type == BT_CHARACTER)
-    result->representation.string = result->value.character.string;
+    result->representation.string
+      = gfc_widechar_to_char (result->value.character.string,
+			      result->value.character.length);
   else
     {
       result->representation.string =