mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-09 07:56:43 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/78351 (comma not terminating READ of formatted input field - ok in 4.1.7, not 4.4.7- maybe related to 25419?)

Browse Source 
2018-11-08  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/78351
	* io/transfer.c (read_sf_internal): Add support for early
	comma termination of internal unit formatted reads.

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

From-SVN: r265946
This commit is contained in:
Jerry DeLisle 2018-11-09 02:46:03 +00:00
parent 648cdca78d
commit 3f3284629b
4 changed files with 114 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2018-11-08 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/78351
* gfortran.dg/read_legacy_comma.f90: New test.
2018-11-08 Peter Bergner <bergner@linux.ibm.com>
PR rtl-optimization/87600

31
gcc/testsuite/gfortran.dg/read_legacy_comma.f90 Normal file
View File

@ -0,0 +1,31 @@
! { dg-do run }
! { dg-options "-std=legacy" }
! PR78351
program read_csv
implicit none
integer, parameter :: dbl = selected_real_kind(p=14, r=99)
call checkit("101,1.,2.,3.,7,7")
call checkit ("102,1.,,3.,,7")
call checkit (",1.,,3.,, ")
contains
subroutine checkit (text)
character(*) :: text
integer :: I1, I2, I3
real(dbl) :: R1, R2, R3
10 format (I8,3ES16.8,2I8)
I1=-99; I2=-99; I3=-99
R1=-99._DBL; R2=-99._DBL; R3=-99._DBL
read(text,10) I1, R1, R2, R3, I2, I3
if (I1 == -99) stop 1
if (I2 == -99) stop 2
if (I3 == -99) stop 3
if (R1 == -99._DBL) stop 4
if (R2 == -99._DBL) stop 5
if (R3 == -99._DBL) stop 6
end subroutine
end program

6
libgfortran/ChangeLog
View File

@ -1,3 +1,9 @@
2018-11-08 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/78351
* io/transfer.c (read_sf_internal): Add support for early
comma termination of internal unit formatted reads.
2018-10-31 Joseph Myers <joseph@codesourcery.com>
PR bootstrap/82856

95
libgfortran/io/transfer.c
View File

@ -241,16 +241,6 @@ read_sf_internal (st_parameter_dt *dtp, size_t *length)
&& dtp->u.p.current_unit->pad_status == PAD_NO)
hit_eof (dtp);
/* If we have seen an eor previously, return a length of 0. The
caller is responsible for correctly padding the input field. */
if (dtp->u.p.sf_seen_eor)
{
*length = 0;
/* Just return something that isn't a NULL pointer, otherwise the
caller thinks an error occurred. */
return (char*) empty_string;
}
/* There are some cases with mixed DTIO where we have read a character
and saved it in the last character buffer, so we need to backup. */
if (unlikely (dtp->u.p.current_unit->child_dtio > 0 &&
@ -260,22 +250,81 @@ read_sf_internal (st_parameter_dt *dtp, size_t *length)
sseek (dtp->u.p.current_unit->s, -1, SEEK_CUR);
}
lorig = *length;
if (is_char4_unit(dtp))
/* To support legacy code we have to scan the input string one byte
at a time because we don't know where an early comma may be and the
requested length could go past the end of a comma shortened
string. We only do this if -std=legacy was given at compile
time. We also do not support this on kind=4 strings. */
printf("allow_std=%d\n", compile_options.warn_std);
if (unlikely(compile_options.warn_std == 0)) // the slow legacy way.
{
gfc_char4_t *p = (gfc_char4_t *) mem_alloc_r4 (dtp->u.p.current_unit->s,
length);
base = fbuf_alloc (dtp->u.p.current_unit, lorig);
for (size_t i = 0; i < *length; i++, p++)
base[i] = *p > 255 ? '?' : (unsigned char) *p;
}
else
base = mem_alloc_r (dtp->u.p.current_unit->s, length);
size_t n;
size_t tmp = 1;
char *q;
if (unlikely (lorig > *length))
/* If we have seen an eor previously, return a length of 0. The
caller is responsible for correctly padding the input field. */
if (dtp->u.p.sf_seen_eor)
{
*length = 0;
/* Just return something that isn't a NULL pointer, otherwise the
caller thinks an error occurred. */
return (char*) empty_string;
}
/* Get the first character of the string to establish the base
address and check for comma or end-of-record condition. */
base = mem_alloc_r (dtp->u.p.current_unit->s, &tmp);
if (tmp == 0)
{
dtp->u.p.sf_seen_eor = 1;
*length = 0;
return (char*) empty_string;
}
if (*base == ',')
{
dtp->u.p.current_unit->bytes_left--;
*length = 0;
return (char*) empty_string;
}
/* Now we scan the rest and deal with either an end-of-file
condition or a comma, as needed. */
for (n = 1; n < *length; n++)
{
q = mem_alloc_r (dtp->u.p.current_unit->s, &tmp);
if (tmp == 0)
{
hit_eof (dtp);
return NULL;
}
if (*q == ',')
{
dtp->u.p.current_unit->bytes_left -= n;
*length = n;
break;
}
}
}
else // the fast way
{
hit_eof (dtp);
return NULL;
lorig = *length;
if (is_char4_unit(dtp))
{
gfc_char4_t *p = (gfc_char4_t *) mem_alloc_r4 (dtp->u.p.current_unit->s,
length);
base = fbuf_alloc (dtp->u.p.current_unit, lorig);
for (size_t i = 0; i < *length; i++, p++)
base[i] = *p > 255 ? '?' : (unsigned char) *p;
}
else
base = mem_alloc_r (dtp->u.p.current_unit->s, length);
if (unlikely (lorig > *length))
{
hit_eof (dtp);
return NULL;
}
}
dtp->u.p.current_unit->bytes_left -= *length;