summaryrefslogtreecommitdiff
path: root/gcc/fortran/primary.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/primary.c')
-rw-r--r--gcc/fortran/primary.c34
1 files changed, 33 insertions, 1 deletions
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 3d076736fdc..d889ed10ac3 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2082,7 +2082,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
{
bool permissible;
- /* These target expressions can ge resolved at any time. */
+ /* These target expressions can be resolved at any time. */
permissible = tgt_expr && tgt_expr->symtree && tgt_expr->symtree->n.sym
&& (tgt_expr->symtree->n.sym->attr.use_assoc
|| tgt_expr->symtree->n.sym->attr.host_assoc
@@ -2879,6 +2879,38 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
if (!this_comp)
goto cleanup;
+ /* For a constant string constructor, make sure the length is
+ correct; truncate of fill with blanks if needed. */
+ if (this_comp->ts.type == BT_CHARACTER && !this_comp->attr.allocatable
+ && this_comp->ts.u.cl && this_comp->ts.u.cl->length
+ && this_comp->ts.u.cl->length->expr_type == EXPR_CONSTANT
+ && actual->expr->expr_type == EXPR_CONSTANT)
+ {
+ ptrdiff_t c, e;
+ c = gfc_mpz_get_hwi (this_comp->ts.u.cl->length->value.integer);
+ e = actual->expr->value.character.length;
+
+ if (c != e)
+ {
+ ptrdiff_t i, to;
+ gfc_char_t *dest;
+ dest = gfc_get_wide_string (c + 1);
+
+ to = e < c ? e : c;
+ for (i = 0; i < to; i++)
+ dest[i] = actual->expr->value.character.string[i];
+
+ for (i = e; i < c; i++)
+ dest[i] = ' ';
+
+ dest[c] = '\0';
+ free (actual->expr->value.character.string);
+
+ actual->expr->value.character.length = c;
+ actual->expr->value.character.string = dest;
+ }
+ }
+
comp_tail->val = actual->expr;
if (actual->expr != NULL)
comp_tail->where = actual->expr->where;