Re: [patch, fortran] PR43217 Output of Hollerith constants which are not a multiple of 4 bytes

[Jerry DeLisle <jvdelisle at frontier dot com>]

On 08/25/2010 08:32 PM, Jerry DeLisle wrote:
> On 08/25/2010 06:15 PM, Jerry DeLisle wrote:
> > Hi,
> >
> > The attached patch fixes this by padding the constant when it is created
> > to fit into a default integer size.
I have updated the patch to include saving the pad size in the expressions type 
specification so that calculated lengths used later can be adjusted to avoid 
spurious warnings.

Test case attached.  I expect to revise this to handle platforms that may have 
different endian-ness.

Regression tested on i686-Gnu-linux.

OK for trunk.

2010-08-26  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.

Index: gfortran.h
===================================================================
--- gfortran.h	(revision 163560)
+++ gfortran.h	(working copy)
@@ -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;
 
Index: ChangeLog
===================================================================
--- ChangeLog	(revision 163560)
+++ ChangeLog	(working copy)
@@ -1,3 +1,10 @@
+2010-08-25  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 ' '.
+
 2010-08-25  Jakub Jelinek  <jakub@redhat.com>
 
 	* trans-decl.c (gfc_build_intrinsic_function_decls): Set
Index: data.c
===================================================================
--- data.c	(revision 163560)
+++ data.c	(working copy)
@@ -100,8 +100,8 @@ find_con_by_component (gfc_component *com, gfc_con
    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 @@ static gfc_expr *
 
   /* 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
     {
       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
     {
Index: arith.c
===================================================================
--- arith.c	(revision 163560)
+++ arith.c	(working copy)
@@ -2260,7 +2260,7 @@ hollerith2representation (gfc_expr *result, gfc_ex
 {
   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)
Index: primary.c
===================================================================
--- primary.c	(revision 163560)
+++ primary.c	(working copy)
@@ -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,8 +279,11 @@ 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++)
 	    {
 	      gfc_char_t c = gfc_next_char_literal (1);
@@ -294,9 +297,14 @@ 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;
 	}

! { dg-do run )
program hello2
  call wrtout (9hHELLO YOU, 9)
  stop
end

subroutine wrtout (iarray, nchrs)
  integer iarray(1)
  integer nchrs

  integer icpw
  data icpw/4/
  integer i, nwrds
  character(len=33) outstr

  nwrds = (nchrs + icpw - 1) /icpw
  write(outstr,'(4(z8," "))') (iarray(i), i=1,nwrds)
  if (outstr.ne."4C4C4548 4F59204F 20202055") call abort
  return
end
! { dg-warning "Hollerith constant" "" { target *-*-* } 3 }
! { dg-warning "Rank mismatch" "" { target *-*-* } 3 }