diff options
Diffstat (limited to 'gcc/fortran/decl.c')
| -rw-r--r-- | gcc/fortran/decl.c | 55 |
1 files changed, 54 insertions, 1 deletions
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 9ad5ef17973..f2d8d74856d 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -27,7 +27,7 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA #include "parse.h" -/* This flag is set if a an old-style length selector is matched +/* This flag is set if an old-style length selector is matched during a type-declaration statement. */ static int old_char_selector; @@ -646,6 +646,30 @@ build_sym (const char *name, gfc_charlen * cl, return SUCCESS; } +/* Set character constant to the given length. The constant will be padded or + truncated. */ + +void +gfc_set_constant_character_len (int len, gfc_expr * expr) +{ + char * s; + int slen; + + gcc_assert (expr->expr_type == EXPR_CONSTANT); + gcc_assert (expr->ts.type == BT_CHARACTER && expr->ts.kind == 1); + + slen = expr->value.character.length; + if (len != slen) + { + s = gfc_getmem (len); + memcpy (s, expr->value.character.string, MIN (len, slen)); + if (len > slen) + memset (&s[slen], ' ', len - slen); + gfc_free (expr->value.character.string); + expr->value.character.string = s; + expr->value.character.length = len; + } +} /* Function called by variable_decl() that adds an initialization expression to a symbol. */ @@ -711,6 +735,35 @@ add_init_expr_to_sym (const char *name, gfc_expr ** initp, && gfc_check_assign_symbol (sym, init) == FAILURE) return FAILURE; + if (sym->ts.type == BT_CHARACTER && sym->ts.cl) + { + /* Update symbol character length according initializer. */ + if (sym->ts.cl->length == NULL) + { + if (init->expr_type == EXPR_CONSTANT) + sym->ts.cl->length = + gfc_int_expr (init->value.character.length); + else if (init->expr_type == EXPR_ARRAY) + sym->ts.cl->length = gfc_copy_expr (init->ts.cl->length); + } + /* Update initializer character length according symbol. */ + else if (sym->ts.cl->length->expr_type == EXPR_CONSTANT) + { + int len = mpz_get_si (sym->ts.cl->length->value.integer); + gfc_constructor * p; + + if (init->expr_type == EXPR_CONSTANT) + gfc_set_constant_character_len (len, init); + else if (init->expr_type == EXPR_ARRAY) + { + gfc_free_expr (init->ts.cl->length); + init->ts.cl->length = gfc_copy_expr (sym->ts.cl->length); + for (p = init->value.constructor; p; p = p->next) + gfc_set_constant_character_len (len, p->expr); + } + } + } + /* Add initializer. Make sure we keep the ranks sane. */ if (sym->attr.dimension && init->rank == 0) init->rank = sym->as->rank; |