diff options
Diffstat (limited to 'libgfortran/io/write.c')
| -rw-r--r-- | libgfortran/io/write.c | 141 |
1 files changed, 140 insertions, 1 deletions
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index d4b1bc8..c8bba3c 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -228,6 +228,138 @@ write_utf8_char4 (st_parameter_dt *dtp, gfc_char4_t *source, } +/* Check the first character in source if we are using CC_FORTRAN + and set the cc.type appropriately. The cc.type is used later by write_cc + to determine the output start-of-record, and next_record_cc to determine the + output end-of-record. + This function is called before the output buffer is allocated, so alloc_len + is set to the appropriate size to allocate. */ + +static void +write_check_cc (st_parameter_dt *dtp, const char **source, int *alloc_len) +{ + /* Only valid for CARRIAGECONTROL=FORTRAN. */ + if (dtp->u.p.current_unit->flags.cc != CC_FORTRAN + || alloc_len == NULL || source == NULL) + return; + + /* Peek at the first character. */ + int c = (*alloc_len > 0) ? (*source)[0] : EOF; + if (c != EOF) + { + /* The start-of-record character which will be printed. */ + dtp->u.p.cc.u.start = '\n'; + /* The number of characters to print at the start-of-record. + len > 1 means copy the SOR character multiple times. + len == 0 means no SOR will be output. */ + dtp->u.p.cc.len = 1; + + switch (c) + { + case '+': + dtp->u.p.cc.type = CCF_OVERPRINT; + dtp->u.p.cc.len = 0; + break; + case '-': + dtp->u.p.cc.type = CCF_ONE_LF; + dtp->u.p.cc.len = 1; + break; + case '0': + dtp->u.p.cc.type = CCF_TWO_LF; + dtp->u.p.cc.len = 2; + break; + case '1': + dtp->u.p.cc.type = CCF_PAGE_FEED; + dtp->u.p.cc.len = 1; + dtp->u.p.cc.u.start = '\f'; + break; + case '$': + dtp->u.p.cc.type = CCF_PROMPT; + dtp->u.p.cc.len = 1; + break; + case '\0': + dtp->u.p.cc.type = CCF_OVERPRINT_NOA; + dtp->u.p.cc.len = 0; + break; + default: + /* In the default case we copy ONE_LF. */ + dtp->u.p.cc.type = CCF_DEFAULT; + dtp->u.p.cc.len = 1; + break; + } + + /* We add n-1 to alloc_len so our write buffer is the right size. + We are replacing the first character, and possibly prepending some + additional characters. Note for n==0, we actually subtract one from + alloc_len, which is correct, since that character is skipped. */ + if (*alloc_len > 0) + { + *source += 1; + *alloc_len += dtp->u.p.cc.len - 1; + } + /* If we have no input, there is no first character to replace. Make + sure we still allocate enough space for the start-of-record string. */ + else + *alloc_len = dtp->u.p.cc.len; + } +} + + +/* Write the start-of-record character(s) for CC_FORTRAN. + Also adjusts the 'cc' struct to contain the end-of-record character + for next_record_cc. + The source_len is set to the remaining length to copy from the source, + after the start-of-record string was inserted. */ + +static char * +write_cc (st_parameter_dt *dtp, char *p, int *source_len) +{ + /* Only valid for CARRIAGECONTROL=FORTRAN. */ + if (dtp->u.p.current_unit->flags.cc != CC_FORTRAN || source_len == NULL) + return p; + + /* Write the start-of-record string to the output buffer. Note that len is + never more than 2. */ + if (dtp->u.p.cc.len > 0) + { + *(p++) = dtp->u.p.cc.u.start; + if (dtp->u.p.cc.len > 1) + *(p++) = dtp->u.p.cc.u.start; + + /* source_len comes from write_check_cc where it is set to the full + allocated length of the output buffer. Therefore we subtract off the + length of the SOR string to obtain the remaining source length. */ + *source_len -= dtp->u.p.cc.len; + } + + /* Common case. */ + dtp->u.p.cc.len = 1; + dtp->u.p.cc.u.end = '\r'; + + /* Update end-of-record character for next_record_w. */ + switch (dtp->u.p.cc.type) + { + case CCF_PROMPT: + case CCF_OVERPRINT_NOA: + /* No end-of-record. */ + dtp->u.p.cc.len = 0; + dtp->u.p.cc.u.end = '\0'; + break; + case CCF_OVERPRINT: + case CCF_ONE_LF: + case CCF_TWO_LF: + case CCF_PAGE_FEED: + case CCF_DEFAULT: + default: + /* Carriage return. */ + dtp->u.p.cc.len = 1; + dtp->u.p.cc.u.end = '\r'; + break; + } + + return p; +} + void write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len) { @@ -296,10 +428,16 @@ write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len) else { #endif + if (dtp->u.p.current_unit->flags.cc == CC_FORTRAN) + write_check_cc (dtp, &source, &wlen); + p = write_block (dtp, wlen); if (p == NULL) return; + if (dtp->u.p.current_unit->flags.cc == CC_FORTRAN) + p = write_cc (dtp, p, &wlen); + if (unlikely (is_char4_unit (dtp))) { gfc_char4_t *p4 = (gfc_char4_t *) p; @@ -1726,7 +1864,8 @@ list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, if (dtp->u.p.first_item) { dtp->u.p.first_item = 0; - write_char (dtp, ' '); + if (dtp->u.p.current_unit->flags.cc != CC_FORTRAN) + write_char (dtp, ' '); } else { |