gdb

	PR fortran/10036:
	* valprint.h (generic_emit_char, generic_printstr): Declare.
	* valprint.c (wchar_printable, append_string_as_wide)
	(print_wchar): Move from c-lang.c.
	(generic_emit_char): New function; mostly taken from c_emit_char.
	(generic_printstr): New function; mostly taken from c_printstr.
	* f-valprint.c (f_val_print) <TYPE_CODE_ARRAY>: Handle strings
	represented as arrays.
	<TYPE_CODE_CHAR>: Treat as TYPE_CODE_INT; recognize as character
	type.
	* f-typeprint.c (f_type_print_base) <TYPE_CODE_CHAR>: Treat
	identically to TYPE_CODE_INT.
	* f-lang.c (f_get_encoding): New function.
	(f_emit_char): Use generic_emit_char.
	(f_printchar): Replace comment.
	(f_printstr): Use generic_printstr.
	* dwarf2read.c (read_base_type) <DW_ATE_unsigned>: Handle Fortran
	"character" types specially.
	<DW_ATE_signed_char, DW_ATE_unsigned_char>: Make TYPE_CODE_CHAR
	for Fortran.
	* c-lang.c (wchar_printable, append_string_as_wide, print_wchar):
	Move to valprint.c
	(c_emit_char): Call generic_emit_char.
	(c_printstr): Call generic_printstr.
gdb/testsuite
	* gdb.fortran/charset.exp: New file.
	* gdb.fortran/charset.f90: New file.

11 files changed, 616 insertions, 528 deletions

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 895d00b..6961d69 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,30 @@
+2011-06-29  Tom Tromey  <tromey@redhat.com>
+
+	PR fortran/10036:
+	* valprint.h (generic_emit_char, generic_printstr): Declare.
+	* valprint.c (wchar_printable, append_string_as_wide)
+	(print_wchar): Move from c-lang.c.
+	(generic_emit_char): New function; mostly taken from c_emit_char.
+	(generic_printstr): New function; mostly taken from c_printstr.
+	* f-valprint.c (f_val_print) <TYPE_CODE_ARRAY>: Handle strings
+	represented as arrays.
+	<TYPE_CODE_CHAR>: Treat as TYPE_CODE_INT; recognize as character
+	type.
+	* f-typeprint.c (f_type_print_base) <TYPE_CODE_CHAR>: Treat
+	identically to TYPE_CODE_INT.
+	* f-lang.c (f_get_encoding): New function.
+	(f_emit_char): Use generic_emit_char.
+	(f_printchar): Replace comment.
+	(f_printstr): Use generic_printstr.
+	* dwarf2read.c (read_base_type) <DW_ATE_unsigned>: Handle Fortran
+	"character" types specially.
+	<DW_ATE_signed_char, DW_ATE_unsigned_char>: Make TYPE_CODE_CHAR
+	for Fortran.
+	* c-lang.c (wchar_printable, append_string_as_wide, print_wchar):
+	Move to valprint.c
+	(c_emit_char): Call generic_emit_char.
+	(c_printstr): Call generic_printstr.
+
 2011-06-29  Gary Benson  <gbenson@redhat.com>
 
 	* breakpoint.c (bpstat_what): Removed duplicated case.
diff --git a/gdb/c-lang.c b/gdb/c-lang.c
index 255fabe..3a35a78 100644
--- a/gdb/c-lang.c
+++ b/gdb/c-lang.c
@@ -140,123 +140,6 @@ classify_type (struct type *elttype, struct gdbarch *gdbarch,
   return result;
 }
 
-/* Return true if print_wchar can display W without resorting to a
-   numeric escape, false otherwise.  */
-
-static int
-wchar_printable (gdb_wchar_t w)
-{
-  return (gdb_iswprint (w)
-	  || w == LCST ('\a') || w == LCST ('\b')
-	  || w == LCST ('\f') || w == LCST ('\n')
-	  || w == LCST ('\r') || w == LCST ('\t')
-	  || w == LCST ('\v'));
-}
-
-/* A helper function that converts the contents of STRING to wide
-   characters and then appends them to OUTPUT.  */
-
-static void
-append_string_as_wide (const char *string,
-		       struct obstack *output)
-{
-  for (; *string; ++string)
-    {
-      gdb_wchar_t w = gdb_btowc (*string);
-      obstack_grow (output, &w, sizeof (gdb_wchar_t));
-    }
-}
-
-/* Print a wide character W to OUTPUT.  ORIG is a pointer to the
-   original (target) bytes representing the character, ORIG_LEN is the
-   number of valid bytes.  WIDTH is the number of bytes in a base
-   characters of the type.  OUTPUT is an obstack to which wide
-   characters are emitted.  QUOTER is a (narrow) character indicating
-   the style of quotes surrounding the character to be printed.
-   NEED_ESCAPE is an in/out flag which is used to track numeric
-   escapes across calls.  */
-
-static void
-print_wchar (gdb_wint_t w, const gdb_byte *orig,
-	     int orig_len, int width,
-	     enum bfd_endian byte_order,
-	     struct obstack *output,
-	     int quoter, int *need_escapep)
-{
-  int need_escape = *need_escapep;
-
-  *need_escapep = 0;
-  if (gdb_iswprint (w) && (!need_escape || (!gdb_iswdigit (w)
-					    && w != LCST ('8')
-					    && w != LCST ('9'))))
-    {
-      gdb_wchar_t wchar = w;
-
-      if (w == gdb_btowc (quoter) || w == LCST ('\\'))
-	obstack_grow_wstr (output, LCST ("\\"));
-      obstack_grow (output, &wchar, sizeof (gdb_wchar_t));
-    }
-  else
-    {
-      switch (w)
-	{
-	case LCST ('\a'):
-	  obstack_grow_wstr (output, LCST ("\\a"));
-	  break;
-	case LCST ('\b'):
-	  obstack_grow_wstr (output, LCST ("\\b"));
-	  break;
-	case LCST ('\f'):
-	  obstack_grow_wstr (output, LCST ("\\f"));
-	  break;
-	case LCST ('\n'):
-	  obstack_grow_wstr (output, LCST ("\\n"));
-	  break;
-	case LCST ('\r'):
-	  obstack_grow_wstr (output, LCST ("\\r"));
-	  break;
-	case LCST ('\t'):
-	  obstack_grow_wstr (output, LCST ("\\t"));
-	  break;
-	case LCST ('\v'):
-	  obstack_grow_wstr (output, LCST ("\\v"));
-	  break;
-	default:
-	  {
-	    int i;
-
-	    for (i = 0; i + width <= orig_len; i += width)
-	      {
-		char octal[30];
-		ULONGEST value;
-
-		value = extract_unsigned_integer (&orig[i], width,
-						  byte_order);
-		/* If the value fits in 3 octal digits, print it that
-		   way.  Otherwise, print it as a hex escape.  */
-		if (value <= 0777)
-		  sprintf (octal, "\\%.3o", (int) (value & 0777));
-		else
-		  sprintf (octal, "\\x%lx", (long) value);
-		append_string_as_wide (octal, output);
-	      }
-	    /* If we somehow have extra bytes, print them now.  */
-	    while (i < orig_len)
-	      {
-		char octal[5];
-
-		sprintf (octal, "\\%.3o", orig[i] & 0xff);
-		append_string_as_wide (octal, output);
-		++i;
-	      }
-
-	    *need_escapep = 1;
-	  }
-	  break;
-	}
-    }
-}
-
 /* Print the character C on STREAM as part of the contents of a
    literal string whose delimiter is QUOTER.  Note that that format
    for printing characters and strings is language specific.  */
@@ -265,85 +148,10 @@ void
 c_emit_char (int c, struct type *type,
 	     struct ui_file *stream, int quoter)
 {
-  enum bfd_endian byte_order
-    = gdbarch_byte_order (get_type_arch (type));
-  struct obstack wchar_buf, output;
-  struct cleanup *cleanups;
   const char *encoding;
-  gdb_byte *buf;
-  struct wchar_iterator *iter;
-  int need_escape = 0;
 
   classify_type (type, get_type_arch (type), &encoding);
-
-  buf = alloca (TYPE_LENGTH (type));
-  pack_long (buf, type, c);
-
-  iter = make_wchar_iterator (buf, TYPE_LENGTH (type),
-			      encoding, TYPE_LENGTH (type));
-  cleanups = make_cleanup_wchar_iterator (iter);
-
-  /* This holds the printable form of the wchar_t data.  */
-  obstack_init (&wchar_buf);
-  make_cleanup_obstack_free (&wchar_buf);
-
-  while (1)
-    {
-      int num_chars;
-      gdb_wchar_t *chars;
-      const gdb_byte *buf;
-      size_t buflen;
-      int print_escape = 1;
-      enum wchar_iterate_result result;
-
-      num_chars = wchar_iterate (iter, &result, &chars, &buf, &buflen);
-      if (num_chars < 0)
-	break;
-      if (num_chars > 0)
-	{
-	  /* If all characters are printable, print them.  Otherwise,
-	     we're going to have to print an escape sequence.  We
-	     check all characters because we want to print the target
-	     bytes in the escape sequence, and we don't know character
-	     boundaries there.  */
-	  int i;
-
-	  print_escape = 0;
-	  for (i = 0; i < num_chars; ++i)
-	    if (!wchar_printable (chars[i]))
-	      {
-		print_escape = 1;
-		break;
-	      }
-
-	  if (!print_escape)
-	    {
-	      for (i = 0; i < num_chars; ++i)
-		print_wchar (chars[i], buf, buflen,
-			     TYPE_LENGTH (type), byte_order,
-			     &wchar_buf, quoter, &need_escape);
-	    }
-	}
-
-      /* This handles the NUM_CHARS == 0 case as well.  */
-      if (print_escape)
-	print_wchar (gdb_WEOF, buf, buflen, TYPE_LENGTH (type),
-		     byte_order, &wchar_buf, quoter, &need_escape);
-    }
-
-  /* The output in the host encoding.  */
-  obstack_init (&output);
-  make_cleanup_obstack_free (&output);
-
-  convert_between_encodings (INTERMEDIATE_ENCODING, host_charset (),
-			     obstack_base (&wchar_buf),
-			     obstack_object_size (&wchar_buf),
-			     1, &output, translit_char);
-  obstack_1grow (&output, '\0');
-
-  fputs_filtered (obstack_base (&output), stream);
-
-  do_cleanups (cleanups);
+  generic_emit_char (c, type, stream, quoter, encoding);
 }
 
 void
@@ -385,6 +193,10 @@ c_printstr (struct ui_file *stream, struct type *type,
 	    const char *user_encoding, int force_ellipses,
 	    const struct value_print_options *options)
 {
+  enum c_string_type str_type;
+  const char *type_encoding;
+  const char *encoding;
+
   enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (type));
   unsigned int i;
   unsigned int things_printed = 0;
@@ -393,35 +205,10 @@ c_printstr (struct ui_file *stream, struct type *type,
   int width = TYPE_LENGTH (type);
   struct obstack wchar_buf, output;
   struct cleanup *cleanup;
-  enum c_string_type str_type;
-  const char *type_encoding;
-  const char *encoding;
   struct wchar_iterator *iter;
   int finished = 0;
   int need_escape = 0;
 
-  if (length == -1)
-    {
-      unsigned long current_char = 1;
-
-      for (i = 0; current_char; ++i)
-	{
-	  QUIT;
-	  current_char = extract_unsigned_integer (string + i * width,
-						   width, byte_order);
-	}
-      length = i;
-    }
-
-  /* If the string was not truncated due to `set print elements', and
-     the last byte of it is a null, we don't print that, in
-     traditional C style.  */
-  if (!force_ellipses
-      && length > 0
-      && (extract_unsigned_integer (string + (length - 1) * width,
-				    width, byte_order) == 0))
-    length--;
-
   str_type = (classify_type (type, get_type_arch (type), &type_encoding)
 	      & ~C_CHAR);
   switch (str_type)
@@ -439,193 +226,10 @@ c_printstr (struct ui_file *stream, struct type *type,
       break;
     }
 
-  encoding = (user_encoding && *user_encoding)
-    ? user_encoding : type_encoding;
-
-  if (length == 0)
-    {
-      fputs_filtered ("\"\"", stream);
-      return;
-    }
-
-  /* Arrange to iterate over the characters, in wchar_t form.  */
-  iter = make_wchar_iterator (string, length * width, encoding, width);
-  cleanup = make_cleanup_wchar_iterator (iter);
-
-  /* WCHAR_BUF is the obstack we use to represent the string in
-     wchar_t form.  */
-  obstack_init (&wchar_buf);
-  make_cleanup_obstack_free (&wchar_buf);
-
-  while (!finished && things_printed < options->print_max)
-    {
-      int num_chars;
-      enum wchar_iterate_result result;
-      gdb_wchar_t *chars;
-      const gdb_byte *buf;
-      size_t buflen;
-
-      QUIT;
-
-      if (need_comma)
-	{
-	  obstack_grow_wstr (&wchar_buf, LCST (", "));
-	  need_comma = 0;
-	}
-
-      num_chars = wchar_iterate (iter, &result, &chars, &buf, &buflen);
-      /* We only look at repetitions when we were able to convert a
-	 single character in isolation.  This makes the code simpler
-	 and probably does the sensible thing in the majority of
-	 cases.  */
-      while (num_chars == 1 && things_printed < options->print_max)
-	{
-	  /* Count the number of repetitions.  */
-	  unsigned int reps = 0;
-	  gdb_wchar_t current_char = chars[0];
-	  const gdb_byte *orig_buf = buf;
-	  int orig_len = buflen;
-
-	  if (need_comma)
-	    {
-	      obstack_grow_wstr (&wchar_buf, LCST (", "));
-	      need_comma = 0;
-	    }
-
-	  while (num_chars == 1 && current_char == chars[0])
-	    {
-	      num_chars = wchar_iterate (iter, &result, &chars,
-					 &buf, &buflen);
-	      ++reps;
-	    }
-
-	  /* Emit CURRENT_CHAR according to the repetition count and
-	     options.  */
-	  if (reps > options->repeat_count_threshold)
-	    {
-	      if (in_quotes)
-		{
-		  if (options->inspect_it)
-		    obstack_grow_wstr (&wchar_buf, LCST ("\\\", "));
-		  else
-		    obstack_grow_wstr (&wchar_buf, LCST ("\", "));
-		  in_quotes = 0;
-		}
-	      obstack_grow_wstr (&wchar_buf, LCST ("'"));
-	      need_escape = 0;
-	      print_wchar (current_char, orig_buf, orig_len, width,
-			   byte_order, &wchar_buf, '\'', &need_escape);
-	      obstack_grow_wstr (&wchar_buf, LCST ("'"));
-	      {
-		/* Painful gyrations.  */
-		int j;
-		char *s = xstrprintf (_(" <repeats %u times>"), reps);
-
-		for (j = 0; s[j]; ++j)
-		  {
-		    gdb_wchar_t w = gdb_btowc (s[j]);
-		    obstack_grow (&wchar_buf, &w, sizeof (gdb_wchar_t));
-		  }
-		xfree (s);
-	      }
-	      things_printed += options->repeat_count_threshold;
-	      need_comma = 1;
-	    }
-	  else
-	    {
-	      /* Saw the character one or more times, but fewer than
-		 the repetition threshold.  */
-	      if (!in_quotes)
-		{
-		  if (options->inspect_it)
-		    obstack_grow_wstr (&wchar_buf, LCST ("\\\""));
-		  else
-		    obstack_grow_wstr (&wchar_buf, LCST ("\""));
-		  in_quotes = 1;
-		  need_escape = 0;
-		}
-
-	      while (reps-- > 0)
-		{
-		  print_wchar (current_char, orig_buf,
-			       orig_len, width,
-			       byte_order, &wchar_buf,
-			       '"', &need_escape);
-		  ++things_printed;
-		}
-	    }
-	}
-
-      /* NUM_CHARS and the other outputs from wchar_iterate are valid
-	 here regardless of which branch was taken above.  */
-      if (num_chars < 0)
-	{
-	  /* Hit EOF.  */
-	  finished = 1;
-	  break;
-	}
-
-      switch (result)
-	{
-	case wchar_iterate_invalid:
-	  if (!in_quotes)
-	    {
-	      if (options->inspect_it)
-		obstack_grow_wstr (&wchar_buf, LCST ("\\\""));
-	      else
-		obstack_grow_wstr (&wchar_buf, LCST ("\""));
-	      in_quotes = 1;
-	    }
-	  need_escape = 0;
-	  print_wchar (gdb_WEOF, buf, buflen, width, byte_order,
-		       &wchar_buf, '"', &need_escape);
-	  break;
-
-	case wchar_iterate_incomplete:
-	  if (in_quotes)
-	    {
-	      if (options->inspect_it)
-		obstack_grow_wstr (&wchar_buf, LCST ("\\\","));
-	      else
-		obstack_grow_wstr (&wchar_buf, LCST ("\","));
-	      in_quotes = 0;
-	    }
-	  obstack_grow_wstr (&wchar_buf,
-			     LCST (" <incomplete sequence "));
-	  print_wchar (gdb_WEOF, buf, buflen, width,
-		       byte_order, &wchar_buf,
-		       0, &need_escape);
-	  obstack_grow_wstr (&wchar_buf, LCST (">"));
-	  finished = 1;
-	  break;
-	}
-    }
-
-  /* Terminate the quotes if necessary.  */
-  if (in_quotes)
-    {
-      if (options->inspect_it)
-	obstack_grow_wstr (&wchar_buf, LCST ("\\\""));
-      else
-	obstack_grow_wstr (&wchar_buf, LCST ("\""));
-    }
-
-  if (force_ellipses || !finished)
-    obstack_grow_wstr (&wchar_buf, LCST ("..."));
-
-  /* OUTPUT is where we collect `char's for printing.  */
-  obstack_init (&output);
-  make_cleanup_obstack_free (&output);
-
-  convert_between_encodings (INTERMEDIATE_ENCODING, host_charset (),
-			     obstack_base (&wchar_buf),
-			     obstack_object_size (&wchar_buf),
-			     1, &output, translit_char);
-  obstack_1grow (&output, '\0');
-
-  fputs_filtered (obstack_base (&output), stream);
+  encoding = (user_encoding && *user_encoding) ? user_encoding : type_encoding;
 
-  do_cleanups (cleanup);
+  generic_printstr (stream, type, string, length, encoding, force_ellipses,
+		    '"', 1, options);
 }
 
 /* Obtain a C string from the inferior storing it in a newly allocated
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index cfe0514..bc958bb 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -8335,15 +8335,21 @@ read_base_type (struct die_info *die, struct dwarf2_cu *cu)
 	break;
       case DW_ATE_unsigned:
 	type_flags |= TYPE_FLAG_UNSIGNED;
+	if (cu->language == language_fortran
+	    && name
+	    && strncmp (name, "character(", sizeof ("character(") - 1) == 0)
+	  code = TYPE_CODE_CHAR;
 	break;
       case DW_ATE_signed_char:
 	if (cu->language == language_ada || cu->language == language_m2
-	    || cu->language == language_pascal)
+	    || cu->language == language_pascal
+	    || cu->language == language_fortran)
 	  code = TYPE_CODE_CHAR;
 	break;
       case DW_ATE_unsigned_char:
 	if (cu->language == language_ada || cu->language == language_m2
-	    || cu->language == language_pascal)
+	    || cu->language == language_pascal
+	    || cu->language == language_fortran)
 	  code = TYPE_CODE_CHAR;
 	type_flags |= TYPE_FLAG_UNSIGNED;
 	break;
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 61513c1..f538eee 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -32,6 +32,7 @@
 #include "valprint.h"
 #include "value.h"
 #include "cp-support.h"
+#include "charset.h"
 
 
 /* Following is dubious stuff that had been in the xcoff reader.  */
@@ -76,6 +77,33 @@ static void f_printchar (int c, struct type *type, struct ui_file * stream);
 static void f_emit_char (int c, struct type *type,
 			 struct ui_file * stream, int quoter);
 
+/* Return the encoding that should be used for the character type
+   TYPE.  */
+
+static const char *
+f_get_encoding (struct type *type)
+{
+  const char *encoding;
+
+  switch (TYPE_LENGTH (type))
+    {
+    case 1:
+      encoding = target_charset (get_type_arch (type));
+      break;
+    case 4:
+      if (gdbarch_byte_order (get_type_arch (type)) == BFD_ENDIAN_BIG)
+	encoding = "UTF-32BE";
+      else
+	encoding = "UTF-32LE";
+      break;
+
+    default:
+      error (_("unrecognized character type"));
+    }
+
+  return encoding;
+}
+
 /* Print the character C on STREAM as part of the contents of a literal
    string whose delimiter is QUOTER.  Note that that format for printing
    characters and strings is language specific.
@@ -85,48 +113,12 @@ static void f_emit_char (int c, struct type *type,
 static void
 f_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
 {
-  c &= 0xFF;			/* Avoid sign bit follies.  */
+  const char *encoding = f_get_encoding (type);
 
-  if (PRINT_LITERAL_FORM (c))
-    {
-      if (c == '\\' || c == quoter)
-	fputs_filtered ("\\", stream);
-      fprintf_filtered (stream, "%c", c);
-    }
-  else
-    {
-      switch (c)
-	{
-	case '\n':
-	  fputs_filtered ("\\n", stream);
-	  break;
-	case '\b':
-	  fputs_filtered ("\\b", stream);
-	  break;
-	case '\t':
-	  fputs_filtered ("\\t", stream);
-	  break;
-	case '\f':
-	  fputs_filtered ("\\f", stream);
-	  break;
-	case '\r':
-	  fputs_filtered ("\\r", stream);
-	  break;
-	case '\033':
-	  fputs_filtered ("\\e", stream);
-	  break;
-	case '\007':
-	  fputs_filtered ("\\a", stream);
-	  break;
-	default:
-	  fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
-	  break;
-	}
-    }
+  generic_emit_char (c, type, stream, quoter, encoding);
 }
 
-/* FIXME:  This is a copy of the same function from c-exp.y.  It should
-   be replaced with a true F77version.  */
+/* Implementation of la_printchar.  */
 
 static void
 f_printchar (int c, struct type *type, struct ui_file *stream)
@@ -148,83 +140,16 @@ f_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string,
 	    unsigned int length, const char *encoding, int force_ellipses,
 	    const struct value_print_options *options)
 {
-  unsigned int i;
-  unsigned int things_printed = 0;
-  int in_quotes = 0;
-  int need_comma = 0;
-
-  if (length == 0)
-    {
-      fputs_filtered ("''", gdb_stdout);
-      return;
-    }
-
-  for (i = 0; i < length && things_printed < options->print_max; ++i)
-    {
-      /* Position of the character we are examining
-         to see whether it is repeated.  */
-      unsigned int rep1;
-      /* Number of repetitions we have detected so far.  */
-      unsigned int reps;
-
-      QUIT;
-
-      if (need_comma)
-	{
-	  fputs_filtered (", ", stream);
-	  need_comma = 0;
-	}
+  const char *type_encoding = f_get_encoding (type);
 
-      rep1 = i + 1;
-      reps = 1;
-      while (rep1 < length && string[rep1] == string[i])
-	{
-	  ++rep1;
-	  ++reps;
-	}
+  if (TYPE_LENGTH (type) == 4)
+    fputs_filtered ("4_", stream);
 
-      if (reps > options->repeat_count_threshold)
-	{
-	  if (in_quotes)
-	    {
-	      if (options->inspect_it)
-		fputs_filtered ("\\', ", stream);
-	      else
-		fputs_filtered ("', ", stream);
-	      in_quotes = 0;
-	    }
-	  f_printchar (string[i], type, stream);
-	  fprintf_filtered (stream, " <repeats %u times>", reps);
-	  i = rep1 - 1;
-	  things_printed += options->repeat_count_threshold;
-	  need_comma = 1;
-	}
-      else
-	{
-	  if (!in_quotes)
-	    {
-	      if (options->inspect_it)
-		fputs_filtered ("\\'", stream);
-	      else
-		fputs_filtered ("'", stream);
-	      in_quotes = 1;
-	    }
-	  LA_EMIT_CHAR (string[i], type, stream, '"');
-	  ++things_printed;
-	}
-    }
-
-  /* Terminate the quotes if necessary.  */
-  if (in_quotes)
-    {
-      if (options->inspect_it)
-	fputs_filtered ("\\'", stream);
-      else
-	fputs_filtered ("'", stream);
-    }
+  if (!encoding || !*encoding)
+    encoding = type_encoding;
 
-  if (force_ellipses || i < length)
-    fputs_filtered ("...", stream);
+  generic_printstr (stream, type, string, length, encoding,
+		    force_ellipses, '\'', 0, options);
 }
 
 
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index ad988d2..6d9e6ec 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -321,10 +321,6 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show,
       break;
 
     case TYPE_CODE_CHAR:
-      /* Override name "char" and make it "character".  */
-      fprintfi_filtered (level, stream, "character");
-      break;
-
     case TYPE_CODE_INT:
       /* There may be some character types that attempt to come
          through as TYPE_CODE_INT since dbxstclass.h is so
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index 3280ddc..66b425d 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -271,10 +271,23 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
       break;
 
     case TYPE_CODE_ARRAY:
-      fprintf_filtered (stream, "(");
-      f77_print_array (type, valaddr, embedded_offset,
-		       address, stream, recurse, original_value, options);
-      fprintf_filtered (stream, ")");
+      if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_CHAR)
+	{
+	  fprintf_filtered (stream, "(");
+	  f77_print_array (type, valaddr, embedded_offset,
+			   address, stream, recurse, original_value, options);
+	  fprintf_filtered (stream, ")");
+	}
+      else
+	{
+	  struct type *ch_type = TYPE_TARGET_TYPE (type);
+
+	  f77_get_dynamic_length_of_aggregate (type);
+	  LA_PRINT_STRING (stream, ch_type,
+			   valaddr + embedded_offset,
+			   TYPE_LENGTH (type) / TYPE_LENGTH (ch_type),
+			   NULL, 0, options);
+	}
       break;
 
     case TYPE_CODE_PTR:
@@ -363,6 +376,7 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
       break;
 
     case TYPE_CODE_INT:
+    case TYPE_CODE_CHAR:
       if (options->format || options->output_format)
 	{
 	  struct value_print_options opts = *options;
@@ -379,7 +393,7 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
 	     Since we don't know whether the value is really intended to
 	     be used as an integer or a character, print the character
 	     equivalent as well.  */
-	  if (TYPE_LENGTH (type) == 1)
+	  if (TYPE_LENGTH (type) == 1 || TYPE_CODE (type) == TYPE_CODE_CHAR)
 	    {
 	      LONGEST c;
 
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 83a1e8f..f156a7c 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2011-06-29  Tom Tromey  <tromey@redhat.com>
 
+	* gdb.fortran/charset.exp: New file.
+	* gdb.fortran/charset.f90: New file.
+
+2011-06-29  Tom Tromey  <tromey@redhat.com>
+
 	PR testsuite/12040:
 	* lib/future.exp: New file, mostly extracted from ada.exp.
 	Rewrote compatibility code to use rename.
diff --git a/gdb/testsuite/gdb.fortran/charset.exp b/gdb/testsuite/gdb.fortran/charset.exp
new file mode 100644
index 0000000..95b7037
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/charset.exp
@@ -0,0 +1,45 @@
+# Copyright 2011 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# This file is part of the gdb testsuite.  It contains tests for evaluating
+# Fortran subarray expression.
+
+if { [skip_fortran_tests] } { return -1 }
+
+set testfile "charset"
+set srcfile ${testfile}.f90
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} {debug additional_flags=-fbackslash f90}] } {
+    return -1
+}
+
+if ![runto MAIN__] {
+    perror "Couldn't run to MAIN__"
+    continue
+}
+
+gdb_breakpoint [gdb_get_line_number "break-here"]
+gdb_continue_to_breakpoint "break-here"
+
+gdb_test "print x" \
+    " = 'j'" \
+    "print fortran narrow character"
+
+gdb_test "print c" \
+    " = 4_'k'" \
+    "print fortran wide character"
+
+gdb_test "print str" \
+    " = 4_'lmnop'" \
+    "print fortran wide string"
diff --git a/gdb/testsuite/gdb.fortran/charset.f90 b/gdb/testsuite/gdb.fortran/charset.f90
new file mode 100644
index 0000000..15cf360
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/charset.f90
@@ -0,0 +1,10 @@
+character(kind=1) :: x
+character(kind=4) :: c
+character(kind=4,len=5) :: str
+x = 'j'
+c = 4_'k'
+str = 4_'lmnop'
+! break-here
+print *, c
+print *, str
+end
diff --git a/gdb/valprint.c b/gdb/valprint.c
index 9bf19f4..b26924a 100644
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -36,6 +36,9 @@
 #include "dfp.h"
 #include "python/python.h"
 #include "ada-lang.h"
+#include "gdb_obstack.h"
+#include "charset.h"
+#include <ctype.h>
 
 #include <errno.h>
 
@@ -1466,6 +1469,450 @@ read_string (CORE_ADDR addr, int len, int width, unsigned int fetchlimit,
   return errcode;
 }
 
+/* Return true if print_wchar can display W without resorting to a
+   numeric escape, false otherwise.  */
+
+static int
+wchar_printable (gdb_wchar_t w)
+{
+  return (gdb_iswprint (w)
+	  || w == LCST ('\a') || w == LCST ('\b')
+	  || w == LCST ('\f') || w == LCST ('\n')
+	  || w == LCST ('\r') || w == LCST ('\t')
+	  || w == LCST ('\v'));
+}
+
+/* A helper function that converts the contents of STRING to wide
+   characters and then appends them to OUTPUT.  */
+
+static void
+append_string_as_wide (const char *string,
+		       struct obstack *output)
+{
+  for (; *string; ++string)
+    {
+      gdb_wchar_t w = gdb_btowc (*string);
+      obstack_grow (output, &w, sizeof (gdb_wchar_t));
+    }
+}
+
+/* Print a wide character W to OUTPUT.  ORIG is a pointer to the
+   original (target) bytes representing the character, ORIG_LEN is the
+   number of valid bytes.  WIDTH is the number of bytes in a base
+   characters of the type.  OUTPUT is an obstack to which wide
+   characters are emitted.  QUOTER is a (narrow) character indicating
+   the style of quotes surrounding the character to be printed.
+   NEED_ESCAPE is an in/out flag which is used to track numeric
+   escapes across calls.  */
+
+static void
+print_wchar (gdb_wint_t w, const gdb_byte *orig,
+	     int orig_len, int width,
+	     enum bfd_endian byte_order,
+	     struct obstack *output,
+	     int quoter, int *need_escapep)
+{
+  int need_escape = *need_escapep;
+
+  *need_escapep = 0;
+  if (gdb_iswprint (w) && (!need_escape || (!gdb_iswdigit (w)
+					    && w != LCST ('8')
+					    && w != LCST ('9'))))
+    {
+      gdb_wchar_t wchar = w;
+
+      if (w == gdb_btowc (quoter) || w == LCST ('\\'))
+	obstack_grow_wstr (output, LCST ("\\"));
+      obstack_grow (output, &wchar, sizeof (gdb_wchar_t));
+    }
+  else
+    {
+      switch (w)
+	{
+	case LCST ('\a'):
+	  obstack_grow_wstr (output, LCST ("\\a"));
+	  break;
+	case LCST ('\b'):
+	  obstack_grow_wstr (output, LCST ("\\b"));
+	  break;
+	case LCST ('\f'):
+	  obstack_grow_wstr (output, LCST ("\\f"));
+	  break;
+	case LCST ('\n'):
+	  obstack_grow_wstr (output, LCST ("\\n"));
+	  break;
+	case LCST ('\r'):
+	  obstack_grow_wstr (output, LCST ("\\r"));
+	  break;
+	case LCST ('\t'):
+	  obstack_grow_wstr (output, LCST ("\\t"));
+	  break;
+	case LCST ('\v'):
+	  obstack_grow_wstr (output, LCST ("\\v"));
+	  break;
+	default:
+	  {
+	    int i;
+
+	    for (i = 0; i + width <= orig_len; i += width)
+	      {
+		char octal[30];
+		ULONGEST value;
+
+		value = extract_unsigned_integer (&orig[i], width,
+						  byte_order);
+		/* If the value fits in 3 octal digits, print it that
+		   way.  Otherwise, print it as a hex escape.  */
+		if (value <= 0777)
+		  sprintf (octal, "\\%.3o", (int) (value & 0777));
+		else
+		  sprintf (octal, "\\x%lx", (long) value);
+		append_string_as_wide (octal, output);
+	      }
+	    /* If we somehow have extra bytes, print them now.  */
+	    while (i < orig_len)
+	      {
+		char octal[5];
+
+		sprintf (octal, "\\%.3o", orig[i] & 0xff);
+		append_string_as_wide (octal, output);
+		++i;
+	      }
+
+	    *need_escapep = 1;
+	  }
+	  break;
+	}
+    }
+}
+
+/* Print the character C on STREAM as part of the contents of a
+   literal string whose delimiter is QUOTER.  ENCODING names the
+   encoding of C.  */
+
+void
+generic_emit_char (int c, struct type *type, struct ui_file *stream,
+		   int quoter, const char *encoding)
+{
+  enum bfd_endian byte_order
+    = gdbarch_byte_order (get_type_arch (type));
+  struct obstack wchar_buf, output;
+  struct cleanup *cleanups;
+  gdb_byte *buf;
+  struct wchar_iterator *iter;
+  int need_escape = 0;
+
+  buf = alloca (TYPE_LENGTH (type));
+  pack_long (buf, type, c);
+
+  iter = make_wchar_iterator (buf, TYPE_LENGTH (type),
+			      encoding, TYPE_LENGTH (type));
+  cleanups = make_cleanup_wchar_iterator (iter);
+
+  /* This holds the printable form of the wchar_t data.  */
+  obstack_init (&wchar_buf);
+  make_cleanup_obstack_free (&wchar_buf);
+
+  while (1)
+    {
+      int num_chars;
+      gdb_wchar_t *chars;
+      const gdb_byte *buf;
+      size_t buflen;
+      int print_escape = 1;
+      enum wchar_iterate_result result;
+
+      num_chars = wchar_iterate (iter, &result, &chars, &buf, &buflen);
+      if (num_chars < 0)
+	break;
+      if (num_chars > 0)
+	{
+	  /* If all characters are printable, print them.  Otherwise,
+	     we're going to have to print an escape sequence.  We
+	     check all characters because we want to print the target
+	     bytes in the escape sequence, and we don't know character
+	     boundaries there.  */
+	  int i;
+
+	  print_escape = 0;
+	  for (i = 0; i < num_chars; ++i)
+	    if (!wchar_printable (chars[i]))
+	      {
+		print_escape = 1;
+		break;
+	      }
+
+	  if (!print_escape)
+	    {
+	      for (i = 0; i < num_chars; ++i)
+		print_wchar (chars[i], buf, buflen,
+			     TYPE_LENGTH (type), byte_order,
+			     &wchar_buf, quoter, &need_escape);
+	    }
+	}
+
+      /* This handles the NUM_CHARS == 0 case as well.  */
+      if (print_escape)
+	print_wchar (gdb_WEOF, buf, buflen, TYPE_LENGTH (type),
+		     byte_order, &wchar_buf, quoter, &need_escape);
+    }
+
+  /* The output in the host encoding.  */
+  obstack_init (&output);
+  make_cleanup_obstack_free (&output);
+
+  convert_between_encodings (INTERMEDIATE_ENCODING, host_charset (),
+			     obstack_base (&wchar_buf),
+			     obstack_object_size (&wchar_buf),
+			     1, &output, translit_char);
+  obstack_1grow (&output, '\0');
+
+  fputs_filtered (obstack_base (&output), stream);
+
+  do_cleanups (cleanups);
+}
+
+/* Print the character string STRING, printing at most LENGTH
+   characters.  LENGTH is -1 if the string is nul terminated.  TYPE is
+   the type of each character.  OPTIONS holds the printing options;
+   printing stops early if the number hits print_max; repeat counts
+   are printed as appropriate.  Print ellipses at the end if we had to
+   stop before printing LENGTH characters, or if FORCE_ELLIPSES.
+   QUOTE_CHAR is the character to print at each end of the string.  If
+   C_STYLE_TERMINATOR is true, and the last character is 0, then it is
+   omitted.  */
+
+void
+generic_printstr (struct ui_file *stream, struct type *type, 
+		  const gdb_byte *string, unsigned int length, 
+		  const char *encoding, int force_ellipses,
+		  int quote_char, int c_style_terminator,
+		  const struct value_print_options *options)
+{
+  enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (type));
+  unsigned int i;
+  unsigned int things_printed = 0;
+  int in_quotes = 0;
+  int need_comma = 0;
+  int width = TYPE_LENGTH (type);
+  struct obstack wchar_buf, output;
+  struct cleanup *cleanup;
+  struct wchar_iterator *iter;
+  int finished = 0;
+  int need_escape = 0;
+  gdb_wchar_t wide_quote_char = gdb_btowc (quote_char);
+
+  if (length == -1)
+    {
+      unsigned long current_char = 1;
+
+      for (i = 0; current_char; ++i)
+	{
+	  QUIT;
+	  current_char = extract_unsigned_integer (string + i * width,
+						   width, byte_order);
+	}
+      length = i;
+    }
+
+  /* If the string was not truncated due to `set print elements', and
+     the last byte of it is a null, we don't print that, in
+     traditional C style.  */
+  if (c_style_terminator
+      && !force_ellipses
+      && length > 0
+      && (extract_unsigned_integer (string + (length - 1) * width,
+				    width, byte_order) == 0))
+    length--;
+
+  if (length == 0)
+    {
+      fputs_filtered ("\"\"", stream);
+      return;
+    }
+
+  /* Arrange to iterate over the characters, in wchar_t form.  */
+  iter = make_wchar_iterator (string, length * width, encoding, width);
+  cleanup = make_cleanup_wchar_iterator (iter);
+
+  /* WCHAR_BUF is the obstack we use to represent the string in
+     wchar_t form.  */
+  obstack_init (&wchar_buf);
+  make_cleanup_obstack_free (&wchar_buf);
+
+  while (!finished && things_printed < options->print_max)
+    {
+      int num_chars;
+      enum wchar_iterate_result result;
+      gdb_wchar_t *chars;
+      const gdb_byte *buf;
+      size_t buflen;
+
+      QUIT;
+
+      if (need_comma)
+	{
+	  obstack_grow_wstr (&wchar_buf, LCST (", "));
+	  need_comma = 0;
+	}
+
+      num_chars = wchar_iterate (iter, &result, &chars, &buf, &buflen);
+      /* We only look at repetitions when we were able to convert a
+	 single character in isolation.  This makes the code simpler
+	 and probably does the sensible thing in the majority of
+	 cases.  */
+      while (num_chars == 1 && things_printed < options->print_max)
+	{
+	  /* Count the number of repetitions.  */
+	  unsigned int reps = 0;
+	  gdb_wchar_t current_char = chars[0];
+	  const gdb_byte *orig_buf = buf;
+	  int orig_len = buflen;
+
+	  if (need_comma)
+	    {
+	      obstack_grow_wstr (&wchar_buf, LCST (", "));
+	      need_comma = 0;
+	    }
+
+	  while (num_chars == 1 && current_char == chars[0])
+	    {
+	      num_chars = wchar_iterate (iter, &result, &chars,
+					 &buf, &buflen);
+	      ++reps;
+	    }
+
+	  /* Emit CURRENT_CHAR according to the repetition count and
+	     options.  */
+	  if (reps > options->repeat_count_threshold)
+	    {
+	      if (in_quotes)
+		{
+		  if (options->inspect_it)
+		    obstack_grow_wstr (&wchar_buf, LCST ("\\"));
+		  obstack_grow (&wchar_buf, &wide_quote_char,
+				sizeof (gdb_wchar_t));
+		  obstack_grow_wstr (&wchar_buf, LCST (", "));
+		  in_quotes = 0;
+		}
+	      obstack_grow_wstr (&wchar_buf, LCST ("'"));
+	      need_escape = 0;
+	      print_wchar (current_char, orig_buf, orig_len, width,
+			   byte_order, &wchar_buf, '\'', &need_escape);
+	      obstack_grow_wstr (&wchar_buf, LCST ("'"));
+	      {
+		/* Painful gyrations.  */
+		int j;
+		char *s = xstrprintf (_(" <repeats %u times>"), reps);
+
+		for (j = 0; s[j]; ++j)
+		  {
+		    gdb_wchar_t w = gdb_btowc (s[j]);
+		    obstack_grow (&wchar_buf, &w, sizeof (gdb_wchar_t));
+		  }
+		xfree (s);
+	      }
+	      things_printed += options->repeat_count_threshold;
+	      need_comma = 1;
+	    }
+	  else
+	    {
+	      /* Saw the character one or more times, but fewer than
+		 the repetition threshold.  */
+	      if (!in_quotes)
+		{
+		  if (options->inspect_it)
+		    obstack_grow_wstr (&wchar_buf, LCST ("\\"));
+		  obstack_grow (&wchar_buf, &wide_quote_char,
+				sizeof (gdb_wchar_t));
+		  in_quotes = 1;
+		  need_escape = 0;
+		}
+
+	      while (reps-- > 0)
+		{
+		  print_wchar (current_char, orig_buf,
+			       orig_len, width,
+			       byte_order, &wchar_buf,
+			       quote_char, &need_escape);
+		  ++things_printed;
+		}
+	    }
+	}
+
+      /* NUM_CHARS and the other outputs from wchar_iterate are valid
+	 here regardless of which branch was taken above.  */
+      if (num_chars < 0)
+	{
+	  /* Hit EOF.  */
+	  finished = 1;
+	  break;
+	}
+
+      switch (result)
+	{
+	case wchar_iterate_invalid:
+	  if (!in_quotes)
+	    {
+	      if (options->inspect_it)
+		obstack_grow_wstr (&wchar_buf, LCST ("\\"));
+	      obstack_grow (&wchar_buf, &wide_quote_char,
+			    sizeof (gdb_wchar_t));
+	      in_quotes = 1;
+	    }
+	  need_escape = 0;
+	  print_wchar (gdb_WEOF, buf, buflen, width, byte_order,
+		       &wchar_buf, quote_char, &need_escape);
+	  break;
+
+	case wchar_iterate_incomplete:
+	  if (in_quotes)
+	    {
+	      if (options->inspect_it)
+		obstack_grow_wstr (&wchar_buf, LCST ("\\"));
+	      obstack_grow (&wchar_buf, &wide_quote_char,
+			    sizeof (gdb_wchar_t));
+	      obstack_grow_wstr (&wchar_buf, LCST (","));
+	      in_quotes = 0;
+	    }
+	  obstack_grow_wstr (&wchar_buf,
+			     LCST (" <incomplete sequence "));
+	  print_wchar (gdb_WEOF, buf, buflen, width,
+		       byte_order, &wchar_buf,
+		       0, &need_escape);
+	  obstack_grow_wstr (&wchar_buf, LCST (">"));
+	  finished = 1;
+	  break;
+	}
+    }
+
+  /* Terminate the quotes if necessary.  */
+  if (in_quotes)
+    {
+      if (options->inspect_it)
+	obstack_grow_wstr (&wchar_buf, LCST ("\\"));
+      obstack_grow (&wchar_buf, &wide_quote_char,
+		    sizeof (gdb_wchar_t));
+    }
+
+  if (force_ellipses || !finished)
+    obstack_grow_wstr (&wchar_buf, LCST ("..."));
+
+  /* OUTPUT is where we collect `char's for printing.  */
+  obstack_init (&output);
+  make_cleanup_obstack_free (&output);
+
+  convert_between_encodings (INTERMEDIATE_ENCODING, host_charset (),
+			     obstack_base (&wchar_buf),
+			     obstack_object_size (&wchar_buf),
+			     1, &output, translit_char);
+  obstack_1grow (&output, '\0');
+
+  fputs_filtered (obstack_base (&output), stream);
+
+  do_cleanups (cleanup);
+}
+
 /* Print a string from the inferior, starting at ADDR and printing up to LEN
    characters, of WIDTH bytes a piece, to STREAM.  If LEN is -1, printing
    stops at the first null byte, otherwise printing proceeds (including null
diff --git a/gdb/valprint.h b/gdb/valprint.h
index b6ea7a9..8aef685 100644
--- a/gdb/valprint.h
+++ b/gdb/valprint.h
@@ -158,4 +158,13 @@ extern void val_print_unavailable (struct ui_file *stream);
 
 extern void val_print_invalid_address (struct ui_file *stream);
 
+extern void generic_emit_char (int c, struct type *type, struct ui_file *stream,
+			       int quoter, const char *encoding);
+
+extern void generic_printstr (struct ui_file *stream, struct type *type, 
+			      const gdb_byte *string, unsigned int length, 
+			      const char *encoding, int force_ellipses,
+			      int quote_char, int c_style_terminator,
+			      const struct value_print_options *options);
+
 #endif