Fortran: Fix READ with padding in BLANK ZERO mode.

	PR fortran/117819

libgfortran/ChangeLog:

	* io/read.c (read_decimal): If the read value is short of the
	specified width and pad mode is PAD yes, check for BLANK ZERO
	and adjust the value accordingly.
	(read_decimal_unsigned): Likewise.
	(read_radix): Likewise.

gcc/testsuite/ChangeLog:

	* gfortran.dg/pr117819.f90: New test.

diff --git a/gcc/testsuite/gfortran.dg/pr117819.f90 b/gcc/testsuite/gfortran.dg/pr117819.f90
new file mode 100644 (file)
index 0000000..d9a9b7f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr117819.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+! PR117819 
+Program xe1
+  Implicit None
+  Character(6) string
+  Integer x
+  Logical :: ok = .True.
+  string = '111111'
+  !print *, "String we read from is: ", string
+  Read(string,1) x
+1 Format(BZ,B8)
+  If (x/=Int(b'11111100')) Then
+    Print *,'FAIL B8 BZ wrong result'
+    Print *,'Expected',Int(b'11111100')
+    Print *,'Received',x
+    ok = .False.
+  End If
+  string = '123456'
+  !print *, "String we read from is: ", string
+  Read(string,2) x
+2 Format(BZ,I8)
+  If (x/=12345600) Then
+    Print *,'FAIL I8 BZ wrong result'
+    Print *,'Expected',12345600
+    Print *,'Received',x
+    ok = .False.
+  End If
+  Read(string,3) x
+3 Format(BZ,O8)
+  If (x/=Int(o'12345600')) Then
+    Print *,'FAIL O8 BZ wrong result'
+    Print *,'Expected',Int(o'12345600')
+    Print *,'Received',x
+    ok = .False.
+  End If
+  Read(string,4) x
+4 Format(BZ,Z8)
+  If (x/=Int(z'12345600')) Then
+    Print *,'FAIL OZ BZ wrong result'
+    Print *,'Expected',Int(z'12345600')
+    Print *,'Received',x
+    ok = .False.
+  End If
+  If (.not. ok) stop 1
+End Program

diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index aa866bf31daed24fe004c6848d9777b6da367f15..46413ade0010f7c40d00a29214609515468a4a4c 100644 (file)
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -753,11 +753,11 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 {
   GFC_UINTEGER_LARGEST value, maxv, maxv_10;
   GFC_INTEGER_LARGEST v;
-  size_t w;
+  size_t w, padding;
   int negative;
   char c, *p;
 
-  w = f->u.w;
+  w = padding = f->u.w;
 
   /* This is a legacy extension, and the frontend will only allow such cases
    * through when -fdec-format-defaults is passed.
@@ -770,6 +770,10 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
   if (p == NULL)
     return;
 
+  /* If the read was not the full width we may need to pad with blanks or zeros
+   * depending on the PAD mode.  Save the number of pad characters needed.  */
+  padding -= w;
+
   p = eat_leading_spaces (&w, p);
   if (w == 0)
     {
@@ -807,7 +811,14 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
     {
       c = next_char (dtp, &p, &w);
       if (c == '\0')
-       break;
+       {
+         if (dtp->u.p.blank_status == BLANK_ZERO)
+           {
+             for (size_t n = 0; n < padding; n++)
+               value = 10 * value;
+           }
+         break;
+       }
 
       if (c == ' ')
         {
@@ -864,11 +875,11 @@ read_decimal_unsigned (st_parameter_dt *dtp, const fnode *f, char *dest,
                       int length)
 {
   GFC_UINTEGER_LARGEST value, old_value;
-  size_t w;
+  size_t w, padding;
   int negative;
   char c, *p;
 
-  w = f->u.w;
+  w = padding = f->u.w;
 
   /* This is a legacy extension, and the frontend will only allow such cases
    * through when -fdec-format-defaults is passed.
@@ -881,6 +892,10 @@ read_decimal_unsigned (st_parameter_dt *dtp, const fnode *f, char *dest,
   if (p == NULL)
     return;
 
+  /* If the read was not the full width we may need to pad with blanks or zeros
+   * depending on the PAD mode.  Save the number of pad characters needed.  */
+  padding -= w;
+
   p = eat_leading_spaces (&w, p);
   if (w == 0)
     {
@@ -917,7 +932,14 @@ read_decimal_unsigned (st_parameter_dt *dtp, const fnode *f, char *dest,
     {
       c = next_char (dtp, &p, &w);
       if (c == '\0')
-       break;
+       {
+         if (dtp->u.p.blank_status == BLANK_ZERO)
+           {
+             for (size_t n = 0; n < padding; n++)
+               value = 10 * value;
+           }
+         break;
+       }
 
       if (c == ' ')
        {
@@ -981,17 +1003,21 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length,
 {
   GFC_UINTEGER_LARGEST value, maxv, maxv_r;
   GFC_INTEGER_LARGEST v;
-  size_t w;
+  size_t w, padding;
   int negative;
   char c, *p;
 
-  w = f->u.w;
+  w = padding = f->u.w;
 
   p = read_block_form (dtp, &w);
 
   if (p == NULL)
     return;
 
+  /* If the read was not the full width we may need to pad with blanks or zeros
+   * depending on the PAD mode.  Save the number of pad characters needed.  */
+  padding -= w;
+
   p = eat_leading_spaces (&w, p);
   if (w == 0)
     {
@@ -1029,7 +1055,14 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length,
     {
       c = next_char (dtp, &p, &w);
       if (c == '\0')
-       break;
+       {
+         if (dtp->u.p.blank_status == BLANK_ZERO)
+           {
+             for (size_t n = 0; n < padding; n++)
+               value = radix * value;
+           }
+         break;
+       }
       if (c == ' ')
         {
          if (dtp->u.p.blank_status == BLANK_NULL) continue;