diff options
| author | Thomas Koenig <tkoenig@gcc.gnu.org> | 2018-03-26 06:29:01 +0000 |
|---|---|---|
| committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2018-03-26 06:29:01 +0000 |
| commit | a48718a2f61f10c0531daa0ef73531174144a14b (patch) | |
| tree | 80bf0ab5272073582eb4ffe9567974e306878acf /gcc/fortran/io.c | |
| parent | 497f7b3e293ef5311a440e950a976cb3d1ebd9d9 (diff) | |
| download | gcc-a48718a2f61f10c0531daa0ef73531174144a14b.zip gcc-a48718a2f61f10c0531daa0ef73531174144a14b.tar.gz gcc-a48718a2f61f10c0531daa0ef73531174144a14b.tar.bz2 | |
re PR fortran/66709 (ICE on formatted io with parameter array specifier fmt)
2018-03-26 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/66709
* io.c: Include constructor.h.
(resolve_tag_format): For a constant character array, concatenate
into a single character expression.
2018-03-26 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/66709
* gfortran.dg/parameter_array_format.f90: New test.
From-SVN: r258850
Diffstat (limited to 'gcc/fortran/io.c')
| -rw-r--r-- | gcc/fortran/io.c | 44 |
1 files changed, 43 insertions, 1 deletions
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index d9f0fb1..10b7e82 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -25,6 +25,7 @@ along with GCC; see the file COPYING3. If not see #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, @@ -1606,7 +1607,7 @@ match_dec_ftag (const io_tag *tag, gfc_open *o) /* 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 @@ -1617,6 +1618,47 @@ resolve_tag_format (const gfc_expr *e) 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. */ |