re PR fortran/37077 (Implement Internal Unit I/O for character KIND=4)

2010-07-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/37077
	* io/read.c (read_default_char4): Add support for reading into a
	kind-4 character variable from a character(kind=4) internal unit.
	* io/io.h (read_block_form4): Add prototype.
	* io/unit.c (get_internal_unit): Add call to fbuf_init.
	(free_internal_unit): Add call to fbuf_destroy. (get_unit): Fix
	whitespace.
	* io/transfer.c (read_sf_internal): Use fbuf_alloc to allocate a string
	to recieve the wide characters translated to single byte chracters.
	(read_block_form): Fix whitespace. (read_block_form4): New function to
	read from a character(kind=4) internal unit into a character(kind=4)
	variable. (read_block_direct): Fix whitespace. (write_block): Fix
	whitespace. (formatted_transfer_scalar_read): Likewise.
	(formatted_transfer_scalar_write): Likewise.
	* io/write.c (write_character): Add support for list directed write of
	a kind=1 character string to a character(kind=4) internal unit.

From-SVN: r162260

1 files changed, 41 insertions, 16 deletions

diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 92983d5..357ee9f 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -383,26 +383,51 @@ read_utf8_char4 (st_parameter_dt *dtp, void *p, int len, int width)
 static void
 read_default_char4 (st_parameter_dt *dtp, char *p, int len, int width)
 {
-  char *s;
-  gfc_char4_t *dest;
   int m, n;
+  gfc_char4_t *dest;
 
-  s = read_block_form (dtp, &width);
-  
-  if (s == NULL)
-    return;
-  if (width > len)
-     s += (width - len);
+  if (is_char4_unit(dtp))
+    {
+      gfc_char4_t *s4;
 
-  m = ((int) width > len) ? len : (int) width;
-  
-  dest = (gfc_char4_t *) p;
-  
-  for (n = 0; n < m; n++, dest++, s++)
-    *dest = (unsigned char ) *s;
+      s4 = (gfc_char4_t *) read_block_form4 (dtp, &width);
+
+      if (s4 == NULL)
+	return;
+      if (width > len)
+	 s4 += (width - len);
 
-  for (n = 0; n < len - (int) width; n++, dest++)
-    *dest = (unsigned char) ' ';
+      m = ((int) width > len) ? len : (int) width;
+
+      dest = (gfc_char4_t *) p;
+
+      for (n = 0; n < m; n++)
+	*dest++ = *s4++;
+
+      for (n = 0; n < len - (int) width; n++)
+	*dest++ = (gfc_char4_t) ' ';
+    }
+  else
+    {
+      char *s;
+
+      s = read_block_form (dtp, &width);
+
+      if (s == NULL)
+	return;
+      if (width > len)
+	 s += (width - len);
+
+      m = ((int) width > len) ? len : (int) width;
+
+      dest = (gfc_char4_t *) p;
+
+      for (n = 0; n < m; n++, dest++, s++)
+	*dest = (unsigned char ) *s;
+
+      for (n = 0; n < len - (int) width; n++, dest++)
+	*dest = (unsigned char) ' ';
+    }
 }