summaryrefslogtreecommitdiff
path: root/libgfortran/io/write.c
diff options
context:
space:
mode:
authorjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>2008-08-16 03:38:31 +0000
committerjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>2008-08-16 03:38:31 +0000
commitd5ca01c331521c6091bfb7353e7e07ab4963b8ee (patch)
tree659ac99319524f53dd916bbef37cd895b6a5cadb /libgfortran/io/write.c
parenta409891fe20f3697194bf6db195de6e1cd201259 (diff)
2008-08-15 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/35863 * intrinsics/selected_char_kind.c: Enable iso_10646. * io/read.c (typedef uchar): New type. (read_utf8): New function to read a single UTF-8 encoded character. (read_utf8_char1): New function to read UTF-8 into a KIND=1 string. (read_default_char1): New functio to read default into KIND=1 string. (read_utf8_char4): New function to read UTF-8 into a KIND=4 string. (read_default_char4): New function to read UTF-8 into a KIND=4 string. (read_a): Modify to use the new functions. (read_a_char4): Modify to use the new functions. * io/write.c (error.h): Add include. (typedef uchar): New type. (write_default_char4): New function to default write KIND=4 string. (write_utf8_char4): New function to UTF-8 write KIND=4 string. (write_a_char4): Modify to use new functions. (write_character): Modify to use new functions. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@139147 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'libgfortran/io/write.c')
-rw-r--r--libgfortran/io/write.c253
1 files changed, 184 insertions, 69 deletions
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index ed50e0d5705e..8194cf8b7193 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -36,10 +36,161 @@ Boston, MA 02110-1301, USA. */
#include <ctype.h>
#include <stdlib.h>
#include <stdbool.h>
+#include <errno.h>
#define star_fill(p, n) memset(p, '*', n)
#include "write_float.def"
+typedef unsigned char uchar;
+
+/* Write out default char4. */
+
+static void
+write_default_char4 (st_parameter_dt *dtp, gfc_char4_t *source,
+ int src_len, int w_len)
+{
+ char *p;
+ int j, k = 0;
+ gfc_char4_t c;
+ uchar d;
+
+ /* Take care of preceding blanks. */
+ if (w_len > src_len)
+ {
+ k = w_len - src_len;
+ p = write_block (dtp, k);
+ if (p == NULL)
+ return;
+ memset (p, ' ', k);
+ }
+
+ /* Get ready to handle delimiters if needed. */
+
+ switch (dtp->u.p.delim_status)
+ {
+ case DELIM_APOSTROPHE:
+ d = '\'';
+ break;
+ case DELIM_QUOTE:
+ d = '"';
+ break;
+ default:
+ d = ' ';
+ break;
+ }
+
+ /* Now process the remaining characters, one at a time. */
+ for (j = k; j < src_len; j++)
+ {
+ c = source[j];
+
+ /* Handle delimiters if any. */
+ if (c == d && d != ' ')
+ {
+ p = write_block (dtp, 2);
+ if (p == NULL)
+ return;
+ *p++ = (uchar) c;
+ }
+ else
+ {
+ p = write_block (dtp, 1);
+ if (p == NULL)
+ return;
+ }
+ *p = c > 255 ? '?' : (uchar) c;
+ }
+}
+
+
+/* Write out UTF-8 converted from char4. */
+
+static void
+write_utf8_char4 (st_parameter_dt *dtp, gfc_char4_t *source,
+ int src_len, int w_len)
+{
+ char *p;
+ int j, k = 0;
+ gfc_char4_t c;
+ static const uchar masks[6] = { 0x00, 0xC0, 0xE0, 0xF0, 0xF8, 0xFC };
+ static const uchar limits[6] = { 0x80, 0xE0, 0xF0, 0xF8, 0xFC, 0xFE };
+ size_t nbytes;
+ uchar buf[6], d, *q;
+
+ /* Take care of preceding blanks. */
+ if (w_len > src_len)
+ {
+ k = w_len - src_len;
+ p = write_block (dtp, k);
+ if (p == NULL)
+ return;
+ memset (p, ' ', k);
+ }
+
+ /* Get ready to handle delimiters if needed. */
+
+ switch (dtp->u.p.delim_status)
+ {
+ case DELIM_APOSTROPHE:
+ d = '\'';
+ break;
+ case DELIM_QUOTE:
+ d = '"';
+ break;
+ default:
+ d = ' ';
+ break;
+ }
+
+ /* Now process the remaining characters, one at a time. */
+ for (j = k; j < src_len; j++)
+ {
+ c = source[j];
+ if (c < 0x80)
+ {
+ /* Handle the delimiters if any. */
+ if (c == d && d != ' ')
+ {
+ p = write_block (dtp, 2);
+ if (p == NULL)
+ return;
+ *p++ = (uchar) c;
+ }
+ else
+ {
+ p = write_block (dtp, 1);
+ if (p == NULL)
+ return;
+ }
+ *p = (uchar) c;
+ }
+ else
+ {
+ /* Convert to UTF-8 sequence. */
+ nbytes = 1;
+ q = &buf[6];
+
+ do
+ {
+ *--q = ((c & 0x3F) | 0x80);
+ c >>= 6;
+ nbytes++;
+ }
+ while (c >= 0x3F || (c & limits[nbytes-1]));
+
+ *--q = (c | masks[nbytes-1]);
+
+ p = write_block (dtp, nbytes);
+ if (p == NULL)
+ return;
+
+ while (q < &buf[6])
+ *p++ = *q++;
+ }
+ }
+}
+
+
void
write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
{
@@ -126,17 +277,16 @@ write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
/* The primary difference between write_a_char4 and write_a is that we have to
- deal with writing from the first byte of the 4-byte character and take care
- of endianess. This currently implements encoding="default" which means we
- write the lowest significant byte. If the 3 most significant bytes are
- not representable emit a '?'. TODO: Implement encoding="UTF-8"
- which will process all 4 bytes and translate to the encoded output. */
+ deal with writing from the first byte of the 4-byte character and pay
+ attention to the most significant bytes. For ENCODING="default" write the
+ lowest significant byte. If the 3 most significant bytes contain
+ non-zero values, emit a '?'. For ENCODING="utf-8", convert the UCS-32 value
+ to the UTF-8 encoded string before writing out. */
void
write_a_char4 (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
{
int wlen;
- char *p;
gfc_char4_t *q;
wlen = f->u.string.length < 0
@@ -173,19 +323,15 @@ write_a_char4 (st_parameter_dt *dtp, const fnode *f, const char *source, int len
/* Write out the previously scanned characters in the string. */
if (bytes > 0)
{
- p = write_block (dtp, bytes);
- if (p == NULL)
- return;
- for (j = 0; j < bytes; j++)
- p[j] = q[j] > 255 ? '?' : (unsigned char) q[j];
+ if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8)
+ write_utf8_char4 (dtp, q, bytes, 0);
+ else
+ write_default_char4 (dtp, q, bytes, 0);
bytes = 0;
}
/* Write out the CR_LF sequence. */
- p = write_block (dtp, 2);
- if (p == NULL)
- return;
- memcpy (p, crlf, 2);
+ write_default_char4 (dtp, crlf, 2, 0);
}
else
bytes++;
@@ -194,32 +340,19 @@ write_a_char4 (st_parameter_dt *dtp, const fnode *f, const char *source, int len
/* Write out any remaining bytes if no LF was found. */
if (bytes > 0)
{
- p = write_block (dtp, bytes);
- if (p == NULL)
- return;
- for (j = 0; j < bytes; j++)
- p[j] = q[j] > 255 ? '?' : (unsigned char) q[j];
+ if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8)
+ write_utf8_char4 (dtp, q, bytes, 0);
+ else
+ write_default_char4 (dtp, q, bytes, 0);
}
}
else
{
#endif
- int j;
- p = write_block (dtp, wlen);
- if (p == NULL)
- return;
-
- if (wlen < len)
- {
- for (j = 0; j < wlen; j++)
- p[j] = q[j] > 255 ? '?' : (unsigned char) q[j];
- }
+ if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8)
+ write_utf8_char4 (dtp, q, len, wlen);
else
- {
- memset (p, ' ', wlen - len);
- for (j = wlen - len; j < wlen; j++)
- p[j] = q[j] > 255 ? '?' : (unsigned char) q[j];
- }
+ write_default_char4 (dtp, q, len, wlen);
#ifdef HAVE_CRLF
}
#endif
@@ -745,8 +878,6 @@ write_character (st_parameter_dt *dtp, const char *source, int kind, int length)
{
int i, extra;
char *p, d;
- gfc_char4_t *q;
-
switch (dtp->u.p.delim_status)
{
@@ -769,9 +900,9 @@ write_character (st_parameter_dt *dtp, const char *source, int kind, int length)
{
extra = 2;
- for (i = 0; i < length; i++)
- if (source[i] == d)
- extra++;
+ for (i = 0; i < length; i++)
+ if (source[i] == d)
+ extra++;
}
p = write_block (dtp, length + extra);
@@ -796,40 +927,24 @@ write_character (st_parameter_dt *dtp, const char *source, int kind, int length)
}
else
{
- /* We have to scan the source string looking for delimiters to determine
- how large the write block needs to be. */
if (d == ' ')
- extra = 0;
- else
{
- extra = 2;
-
- q = (gfc_char4_t *) source;
- for (i = 0; i < length; i++, q++)
- if (*q == (gfc_char4_t) d)
- extra++;
- }
-
- p = write_block (dtp, length + extra);
- if (p == NULL)
- return;
-
- if (d == ' ')
- {
- q = (gfc_char4_t *) source;
- for (i = 0; i < length; i++, q++)
- p[i] = *q > 255 ? '?' : (unsigned char) *q;
+ if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8)
+ write_utf8_char4 (dtp, (gfc_char4_t *) source, length, 0);
+ else
+ write_default_char4 (dtp, (gfc_char4_t *) source, length, 0);
}
else
{
- *p++ = d;
- q = (gfc_char4_t *) source;
- for (i = 0; i < length; i++, q++)
- {
- *p++ = *q > 255 ? '?' : (unsigned char) *q;
- if (*q == (gfc_char4_t) d)
- *p++ = d;
- }
+ p = write_block (dtp, 1);
+ *p = d;
+
+ if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8)
+ write_utf8_char4 (dtp, (gfc_char4_t *) source, length, 0);
+ else
+ write_default_char4 (dtp, (gfc_char4_t *) source, length, 0);
+
+ p = write_block (dtp, 1);
*p = d;
}
}