+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.
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
+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>
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;
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;
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);
}
while (n < *length);
+ if (ioparm.size != NULL)
+ *ioparm.size += *length;
+
return base;
}
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,
g.first_item = 1;
g.item_count = 0;
sf_seen_eor = 0;
+ eor_condition = 0;
pre_position ();
length = 1;
/* sf_read has already terminated input because of an '\n' */
if (sf_seen_eor)
- break;
+ {
+ sf_seen_eor=0;
+ break;
+ }
do
{
static void
finalize_transfer (void)
{
+
+ if (eor_condition)
+ {
+ generate_error (ERROR_EOR, NULL);
+ return;
+ }
+
if (ioparm.library_return != LIBRARY_OK)
return;
projects / thirdparty / gcc.git / commitdiff
