locus old_loc;
gfc_expr *e = NULL;
const char *msg;
- int num;
+ int num, pad;
int i;
old_loc = gfc_current_locus;
e = gfc_get_constant_expr (BT_HOLLERITH, gfc_default_character_kind,
&gfc_current_locus);
- e->representation.string = XCNEWVEC (char, num + 1);
+ /* Calculate padding needed to fit default integer memory. */
+ pad = gfc_default_integer_kind - (num % gfc_default_integer_kind);
+
+ e->representation.string = XCNEWVEC (char, num + pad + 1);
for (i = 0; i < num; i++)
{
e->representation.string[i] = (unsigned char) c;
}
- e->representation.string[num] = '\0';
- e->representation.length = num;
+ /* Now pad with blanks and end with a null char. */
+ for (i = 0; i < pad; i++)
+ e->representation.string[num + i] = ' ';
+
+ e->representation.string[num + i] = '\0';
+ e->representation.length = num + pad;
+ e->ts.u.pad = pad;
*result = e;
return MATCH_YES;
}
}
+ /* For associate names, we may not yet know whether they are arrays or not.
+ Thus if we have one and parentheses follow, we have to assume that it
+ actually is one for now. The final decision will be made at
+ resolution time, of course. */
+ if (sym->assoc && gfc_peek_ascii_char () == '(')
+ sym->attr.dimension = 1;
+
if ((equiv_flag && gfc_peek_ascii_char () == '(')
|| gfc_peek_ascii_char () == '[' || sym->attr.codimension
|| (sym->attr.dimension && !sym->attr.proc_pointer
if (sym->ts.type == BT_CLASS)
{
dimension = CLASS_DATA (sym)->attr.dimension;
- pointer = CLASS_DATA (sym)->attr.pointer;
+ pointer = CLASS_DATA (sym)->attr.class_pointer;
allocatable = CLASS_DATA (sym)->attr.allocatable;
}
else
if (comp->ts.type == BT_CLASS)
{
- pointer = CLASS_DATA (comp)->attr.pointer;
+ pointer = CLASS_DATA (comp)->attr.class_pointer;
allocatable = CLASS_DATA (comp)->attr.allocatable;
}
else
attr.pointer = pointer;
attr.allocatable = allocatable;
attr.target = target;
+ attr.save = sym->attr.save;
return attr;
}
if (sym->ts.type == BT_CLASS)
{
attr.dimension = CLASS_DATA (sym)->attr.dimension;
- attr.pointer = CLASS_DATA (sym)->attr.pointer;
+ attr.pointer = CLASS_DATA (sym)->attr.class_pointer;
attr.allocatable = CLASS_DATA (sym)->attr.allocatable;
}
}
gfc_error ("Assigning to PROTECTED variable at %C");
return MATCH_ERROR;
}
- if (sym->assoc && !sym->assoc->variable)
- {
- gfc_error ("'%s' associated to expression can't appear in a variable"
- " definition context at %C", sym->name);
- return MATCH_ERROR;
- }
+ if (sym->assoc)
+ sym->assoc->variable = 1;
break;
case FL_UNKNOWN: