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

[multiple changes] 

2005-04-10  Thomas Koenig <Thomas.Koenig@online.de>

        PR libfortran/17992
        PR libfortran/19568
        PR libfortran/19595
        PR libfortran/20005
        PR libfortran/20092
        PR libfortran/20131
        PR libfortran/20138
        PR libfortran/20661
        PR libfortran/20744
        * io/transfer.c (top level): eor_condition: New static variable.
        (read_sf): Remove unnecessary zeroing of buffer (there is enough
        information in its length).
        Return a string of length 0 (to be padded by caller) if EOR was
        seen previously.
        Remove erroneous special casing of EOR for standard input.
        Set eor_condition for non-advancing I/O if an end of line was
        detected.
        Increment ioparm.size if necessary.
        (formatted_transfer):  Skip the function if there is an EOR condition.
        (data_transfer_init):  Initialize eor_condition to zero (false).
        (next_record_r):  Clear sf_seen_eor if a \n has been seen already.
        (finalize_transfer):  If there is an EOR condition, raise the error.

2005-04-10   Thomas Koenig  <Thomas.Koenig@online.de>

        * eor_handling_1.f90: New test case.
        * eor_handling_2.f90: New test case.
        * eor_handling_3.f90: New test case.
        * eor_handling_4.f90: New test case.
        * eor_handling_5.f90: New test case.
        * noadv_size.f90: New test case.
        * pad_no.f90: New test case.

From-SVN: r97943
This commit is contained in:
Thomas Koenig 2005-04-10 08:35:39 +00:00 committed by Thomas Koenig
parent ecf9c079e2
commit 59afe4b424
10 changed files with 174 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,13 @@
2005-04-10 Thomas Koenig <Thomas.Koenig@online.de>
* eor_handling_1.f90: New test case.
* eor_handling_2.f90: New test case.
* eor_handling_3.f90: New test case.
* eor_handling_4.f90: New test case.
* eor_handling_5.f90: New test case.
* noadv_size.f90: New test case.
* pad_no.f90: New test case.
2005-04-10 Richard Sandiford <rsandifo@redhat.com>
* gcc.c-torture/execute/20050410-1.c: New test.

14
gcc/testsuite/gfortran.dg/eor_handling_1.f90 Normal file
View File

@ -0,0 +1,14 @@
! { dg-do run }
! PR 17992: Reading an empty file should yield zero with pad='YES'
! (which is the default).
! Test case supplied by milan@cmm.ki.si.
program main
open(77,status='scratch')
write(77,'(A)') '',''
rewind(77)
i = 42
j = 42
read(77,'(/2i2)') i,j
if (i /= 0 .or. j /= 0) call abort
close(77)
end program main

13
gcc/testsuite/gfortran.dg/eor_handling_2.f90 Normal file
View File

@ -0,0 +1,13 @@
! { dg-do run }
! PR 19568: Don't read across end of line when the format is longer
! than the line length and pad='yes' (default)
program main
character(len=1) c1(10),c2(10)
open(77,status='scratch')
write(77,'(A)') 'Line 1','Line 2','Line 3'
rewind(77)
read(77,'(10A1)'), c1
read(77,'(10A1)'), c2
if (c1(1) /= 'L' .or. c2(1) /= 'L') call abort
close(77)
end program main

13
gcc/testsuite/gfortran.dg/eor_handling_3.f90 Normal file
View File

@ -0,0 +1,13 @@
! { dg-do run }
! PR 19595: Handle end-of-record condition with pad=yes (default)
program main
integer i1, i2
open(77,status='scratch')
write (77,'(A)') '123','456'
rewind(77)
read(77,'(2I2)',advance='no',eor=100) i1,i2
call abort
100 continue
if (i1 /= 12 .or. i2 /= 3) call abort
close(77)
end program main

17
gcc/testsuite/gfortran.dg/eor_handling_4.f90 Normal file
View File

@ -0,0 +1,17 @@
! { dg-do run }
! PR 20092, 20131: Handle end-of-record condition with pad=yes (default)
! for standard input. This test case only really tests anything if,
! by changing unit 5, you get to manipulate the standard input.
program main
character(len=1) a(80)
close(5)
open(5,status="scratch")
write(5,'(A)') 'one', 'two', 's'
rewind(5)
do i=1,4
read(5,'(80a1)') a
if (a(1) == 's') goto 100
end do
call abort
100 continue
end program main

19
gcc/testsuite/gfortran.dg/eor_handling_5.f90 Normal file
View File

@ -0,0 +1,19 @@
! { dg-do run }
! PR 20661: Handle non-advancing I/O with iostat
! Test case by Walt Brainerd, The Fortran Company
program fc002
character(len=1) :: c
integer :: k,k2
character(len=*), parameter :: f="(a)"
open(11,status="scratch", iostat=k)
if (k /= 0) call abort
write(11,f) "x"
rewind (11)
read(11, f, advance="no", iostat=k) c
if (k /= 0) call abort
read(11, f, advance="no", iostat=k) c
if (k >= 0) call abort
read(11, f, advance="no", iostat=k2) c
if (k2 >= 0 .or. k == k2) call abort
end program fc002

11
gcc/testsuite/gfortran.dg/noadv_size.f90 Normal file
View File

@ -0,0 +1,11 @@
! { dg-do run }
! PR 20774: Handle size parameter for non-advancing I/O correctly
program main
open(77,status='scratch')
write(77,'(A)') '123'
rewind(77)
read(77,'(2I2)',advance='no',iostat=k,size=n) i1,i2
if (k >=0) call abort
if (n /= 3) call abort
if (i1 /= 12 .or. i2 /= 3) call abort
end program main

15
gcc/testsuite/gfortran.dg/pad_no.f90 Normal file
View File

@ -0,0 +1,15 @@
! { dg-do run }
! Test correct operation for pad='no'.
program main
character(len=1) line(2)
line = 'x'
open(77,status='scratch',pad='no')
write(77,'(A)') 'a','b'
rewind(77)
read(77,'(2A)',iostat=i) line(1)
if (line(1) /= 'a' .or. line(2) /= 'x') call abort
rewind(77)
line = 'y'
read(77,'(2A)',iostat=i,advance='no') line
if (line(1) /= 'a' .or. line(2) /= 'y') call abort
end program main

25
libgfortran/ChangeLog
View File

@ -1,3 +1,28 @@
2005-04-10 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/17992
PR libfortran/19568
PR libfortran/19595
PR libfortran/20005
PR libfortran/20092
PR libfortran/20131
PR libfortran/20138
PR libfortran/20661
PR libfortran/20744
* io/transfer.c (top level): eor_condition: New static variable.
(read_sf): Remove unnecessary zeroing of buffer (there is enough
information in its length).
Return a string of length 0 (to be padded by caller) if EOR was
seen previously.
Remove erroneous special casing of EOR for standard input.
Set eor_condition for non-advancing I/O if an end of line was
detected.
Increment ioparm.size if necessary.
(formatted_transfer): Skip the function if there is an EOR condition.
(data_transfer_init): Initialize eor_condition to zero (false).
(next_record_r): Clear sf_seen_eor if a \n has been seen already.
(finalize_transfer): If there is an EOR condition, raise the error.
2005-04-09 Bud Davis <bdavis@gfortran.org>
Steven G. Kargl <kargls@comcast.net>

45
libgfortran/io/transfer.c
View File

@ -79,6 +79,7 @@ export_proto(transfer_complex);
gfc_unit *current_unit = NULL;
static int sf_seen_eor = 0;
static int eor_condition = 0;
char scratch[SCRATCH_SIZE] = { };
static char *line_buffer = NULL;
@ -150,7 +151,13 @@ read_sf (int *length)
else
p = base = data;
memset(base,'\0',*length);
/* If we have seen an eor previously, return a length of 0. The
caller is responsible for correctly padding the input field. */
if (sf_seen_eor)
{
*length = 0;
return base;
}
current_unit->bytes_left = options.default_recl;
readlen = 1;
@ -179,13 +186,16 @@ read_sf (int *length)
if (readlen < 1 || *q == '\n' || *q == '\r')
{
/* ??? What is this for? */
if (current_unit->unit_number == options.stdin_unit)
{
if (n <= 0)
continue;
}
/* Unexpected end of line. */
/* If we see an EOR during non-advancing I/O, we need to skip
the rest of the I/O statement. Set the corresponding flag. */
if (advance_status == ADVANCE_NO)
eor_condition = 1;
/* Without padding, terminate the I/O statement without assigning
the value. With padding, the value still needs to be assigned,
so we can just continue with a short read. */
if (current_unit->flags.pad == PAD_NO)
{
generate_error (ERROR_EOR, NULL);
@ -204,6 +214,9 @@ read_sf (int *length)
}
while (n < *length);
if (ioparm.size != NULL)
*ioparm.size += *length;
return base;
}
@ -434,6 +447,11 @@ formatted_transfer (bt type, void *p, int len)
if (type == BT_COMPLEX)
type = BT_REAL;
/* If there's an EOR condition, we simulate finalizing the transfer
by doing nothing. */
if (eor_condition)
return;
for (;;)
{
/* If reversion has occurred and there is another real data item,
@ -1121,6 +1139,7 @@ data_transfer_init (int read_flag)
g.first_item = 1;
g.item_count = 0;
sf_seen_eor = 0;
eor_condition = 0;
pre_position ();
@ -1236,7 +1255,10 @@ next_record_r (int done)
length = 1;
/* sf_read has already terminated input because of an '\n' */
if (sf_seen_eor)
break;
{
sf_seen_eor=0;
break;
}
do
{
@ -1402,6 +1424,13 @@ next_record (int done)
static void
finalize_transfer (void)
{
if (eor_condition)
{
generate_error (ERROR_EOR, NULL);
return;
}
if (ioparm.library_return != LIBRARY_OK)
return;