OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Jerry DeLisle 2010-08-27 06:50:03 +00:00
parent 9f8f1def9d
commit 401fcd3b8f
5 changed files with 30 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/fortran/ChangeLog
View File

@ -1,3 +1,15 @@
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>
PR fortran/38936

2
gcc/fortran/arith.c
View File

@ -2260,7 +2260,7 @@ hollerith2representation (gfc_expr *result, gfc_expr *src)
{
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);
if (src_len > result_len)

8
gcc/fortran/data.c
View File

@ -100,8 +100,8 @@ find_con_by_component (gfc_component *com, gfc_constructor_base base)
according to normal assignment rules. */
static gfc_expr *
create_character_intializer (gfc_expr *init, gfc_typespec *ts,
gfc_ref *ref, gfc_expr *rvalue)
create_character_initializer (gfc_expr *init, gfc_typespec *ts,
gfc_ref *ref, gfc_expr *rvalue)
{
int len, start, end;
gfc_char_t *dest;
@ -149,7 +149,7 @@ create_character_intializer (gfc_expr *init, gfc_typespec *ts,
/* Copy the initial value. */
if (rvalue->ts.type == BT_HOLLERITH)
len = rvalue->representation.length;
len = rvalue->representation.length - rvalue->ts.u.pad;
else
len = rvalue->value.character.length;
@ -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))
return FAILURE;
expr = create_character_intializer (init, last_ts, ref, rvalue);
expr = create_character_initializer (init, last_ts, ref, rvalue);
}
else
{

1
gcc/fortran/gfortran.h
View File

@ -880,6 +880,7 @@ typedef struct
{
struct gfc_symbol *derived; /* For derived types only. */
gfc_charlen *cl; /* For character types only. */
int pad; /* For hollerith types only. */
}
u;

16
gcc/fortran/primary.c
View File

@ -242,7 +242,7 @@ match_hollerith_constant (gfc_expr **result)
locus old_loc;
gfc_expr *e = NULL;
const char *msg;
int num;
int num, pad;
int i;
old_loc = gfc_current_locus;
@ -279,7 +279,10 @@ match_hollerith_constant (gfc_expr **result)
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++)
{
@ -294,8 +297,13 @@ match_hollerith_constant (gfc_expr **result)
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;