Mercurial > hg > CbC > CbC_gcc
diff gcc/fortran/io.c @ 131:84e7813d76e9
gcc-8.2
author | mir3636 |
---|---|
date | Thu, 25 Oct 2018 07:37:49 +0900 |
parents | 04ced10e8804 |
children | 1830386684a0 |
line wrap: on
line diff
--- a/gcc/fortran/io.c Fri Oct 27 22:46:09 2017 +0900 +++ b/gcc/fortran/io.c Thu Oct 25 07:37:49 2018 +0900 @@ -1,5 +1,5 @@ /* Deal with I/O statements & related stuff. - Copyright (C) 2000-2017 Free Software Foundation, Inc. + Copyright (C) 2000-2018 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -25,6 +25,7 @@ #include "gfortran.h" #include "match.h" #include "parse.h" +#include "constructor.h" gfc_st_label format_asterisk = {0, NULL, NULL, -1, ST_LABEL_FORMAT, ST_LABEL_FORMAT, NULL, @@ -985,6 +986,9 @@ case FMT_COMMA: goto format_item; + case FMT_COLON: + goto format_item_1; + case FMT_LPAREN: dtio_vlist: @@ -1603,7 +1607,7 @@ /* Resolution of the FORMAT tag, to be called from resolve_tag. */ static bool -resolve_tag_format (const gfc_expr *e) +resolve_tag_format (gfc_expr *e) { if (e->expr_type == EXPR_CONSTANT && (e->ts.type != BT_CHARACTER @@ -1614,6 +1618,47 @@ return false; } + /* Concatenate a constant character array into a single character + expression. */ + + if ((e->expr_type == EXPR_ARRAY || e->rank > 0) + && e->ts.type == BT_CHARACTER + && gfc_is_constant_expr (e)) + { + if (e->expr_type == EXPR_VARIABLE + && e->symtree->n.sym->attr.flavor == FL_PARAMETER) + gfc_simplify_expr (e, 1); + + if (e->expr_type == EXPR_ARRAY) + { + gfc_constructor *c; + gfc_charlen_t n, len; + gfc_expr *r; + gfc_char_t *dest, *src; + + n = 0; + c = gfc_constructor_first (e->value.constructor); + len = c->expr->value.character.length; + + for ( ; c; c = gfc_constructor_next (c)) + n += len; + + r = gfc_get_character_expr (e->ts.kind, &e->where, NULL, n); + dest = r->value.character.string; + + for (c = gfc_constructor_first (e->value.constructor); + c; c = gfc_constructor_next (c)) + { + src = c->expr->value.character.string; + for (gfc_charlen_t i = 0 ; i < len; i++) + *dest++ = *src++; + } + + gfc_replace_expr (e, r); + return true; + } + } + /* If e's rank is zero and e is not an element of an array, it should be of integer or character type. The integer variable should be ASSIGNED. */ @@ -4246,9 +4291,10 @@ goto syntax; } - /* See if we want to use defaults for missing exponents in real transfers. */ + /* See if we want to use defaults for missing exponents in real transfers + and other DEC runtime extensions. */ if (flag_dec) - dt->default_exp = 1; + dt->dec_ext = 1; /* A full IO statement has been matched. Check the constraints. spec_end is supplied for cases where no locus is supplied. */