Commit 401fcd3b by Jerry DeLisle

re PR fortran/43217 (Output of Hollerith constants which are not a multiple of 4 bytes)

2010-08-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/43217
	* primary.c (match_hollerith_constant): Calculate padding needed to
	fill default integer and allocate string for that size.  Set pad bytes
	to ' '.
	* gfortran.h: Add hollerith pad value to type spec union.
	* data.c (create_character_initializer): Fix spelling of function name.
	Use hollerith pad value to calculate length.
	* arith.c (hollerith2representation); Use hollerith pad value to
	calculate length.

From-SVN: r163581
parent 9f8f1def
2010-08-27 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/43217
* primary.c (match_hollerith_constant): Calculate padding needed to
fill default integer and allocate string for that size. Set pad bytes
to ' '.
* gfortran.h: Add hollerith pad value to type spec union.
* data.c (create_character_initializer): Fix spelling of function name.
Use hollerith pad value to calculate length.
* arith.c (hollerith2representation); Use hollerith pad value to
calculate length.
2010-08-26 Daniel Kraft <d@domob.eu> 2010-08-26 Daniel Kraft <d@domob.eu>
PR fortran/38936 PR fortran/38936
......
...@@ -2260,7 +2260,7 @@ hollerith2representation (gfc_expr *result, gfc_expr *src) ...@@ -2260,7 +2260,7 @@ hollerith2representation (gfc_expr *result, gfc_expr *src)
{ {
int src_len, result_len; int src_len, result_len;
src_len = src->representation.length; src_len = src->representation.length - src->ts.u.pad;
result_len = gfc_target_expr_size (result); result_len = gfc_target_expr_size (result);
if (src_len > result_len) if (src_len > result_len)
......
...@@ -100,8 +100,8 @@ find_con_by_component (gfc_component *com, gfc_constructor_base base) ...@@ -100,8 +100,8 @@ find_con_by_component (gfc_component *com, gfc_constructor_base base)
according to normal assignment rules. */ according to normal assignment rules. */
static gfc_expr * static gfc_expr *
create_character_intializer (gfc_expr *init, gfc_typespec *ts, create_character_initializer (gfc_expr *init, gfc_typespec *ts,
gfc_ref *ref, gfc_expr *rvalue) gfc_ref *ref, gfc_expr *rvalue)
{ {
int len, start, end; int len, start, end;
gfc_char_t *dest; gfc_char_t *dest;
...@@ -149,7 +149,7 @@ create_character_intializer (gfc_expr *init, gfc_typespec *ts, ...@@ -149,7 +149,7 @@ create_character_intializer (gfc_expr *init, gfc_typespec *ts,
/* Copy the initial value. */ /* Copy the initial value. */
if (rvalue->ts.type == BT_HOLLERITH) if (rvalue->ts.type == BT_HOLLERITH)
len = rvalue->representation.length; len = rvalue->representation.length - rvalue->ts.u.pad;
else else
len = rvalue->value.character.length; len = rvalue->value.character.length;
...@@ -342,7 +342,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index) ...@@ -342,7 +342,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
{ {
if (lvalue->ts.u.cl->length == NULL && !(ref && ref->u.ss.length != NULL)) if (lvalue->ts.u.cl->length == NULL && !(ref && ref->u.ss.length != NULL))
return FAILURE; return FAILURE;
expr = create_character_intializer (init, last_ts, ref, rvalue); expr = create_character_initializer (init, last_ts, ref, rvalue);
} }
else else
{ {
......
...@@ -880,6 +880,7 @@ typedef struct ...@@ -880,6 +880,7 @@ typedef struct
{ {
struct gfc_symbol *derived; /* For derived types only. */ struct gfc_symbol *derived; /* For derived types only. */
gfc_charlen *cl; /* For character types only. */ gfc_charlen *cl; /* For character types only. */
int pad; /* For hollerith types only. */
} }
u; u;
......
...@@ -242,7 +242,7 @@ match_hollerith_constant (gfc_expr **result) ...@@ -242,7 +242,7 @@ match_hollerith_constant (gfc_expr **result)
locus old_loc; locus old_loc;
gfc_expr *e = NULL; gfc_expr *e = NULL;
const char *msg; const char *msg;
int num; int num, pad;
int i; int i;
old_loc = gfc_current_locus; old_loc = gfc_current_locus;
...@@ -279,7 +279,10 @@ match_hollerith_constant (gfc_expr **result) ...@@ -279,7 +279,10 @@ match_hollerith_constant (gfc_expr **result)
e = gfc_get_constant_expr (BT_HOLLERITH, gfc_default_character_kind, e = gfc_get_constant_expr (BT_HOLLERITH, gfc_default_character_kind,
&gfc_current_locus); &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++) for (i = 0; i < num; i++)
{ {
...@@ -294,8 +297,13 @@ match_hollerith_constant (gfc_expr **result) ...@@ -294,8 +297,13 @@ match_hollerith_constant (gfc_expr **result)
e->representation.string[i] = (unsigned char) c; e->representation.string[i] = (unsigned char) c;
} }
e->representation.string[num] = '\0'; /* Now pad with blanks and end with a null char. */
e->representation.length = num; 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; *result = e;
return MATCH_YES; return MATCH_YES;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment