diff --git a/gcc/testsuite/gfortran.dg/pr117819.f90 b/gcc/testsuite/gfortran.dg/pr117819.f90 new file mode 100644 index 0000000000000000000000000000000000000000..d9a9b7f6f9be06f3e3a8dc8aa3a601e121344b01 --- /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 --- 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;