From 59afe4b424016454a2a119a26743d0b75c46e9bc Mon Sep 17 00:00:00 2001
From: Thomas Koenig <Thomas.Koenig@online.de>
Date: Sun, 10 Apr 2005 08:35:39 +0000
Subject: [PATCH] [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
---
gcc/testsuite/ChangeLog | 10 +++++
gcc/testsuite/gfortran.dg/eor_handling_1.f90 | 14 ++++++
gcc/testsuite/gfortran.dg/eor_handling_2.f90 | 13 ++++++
gcc/testsuite/gfortran.dg/eor_handling_3.f90 | 13 ++++++
gcc/testsuite/gfortran.dg/eor_handling_4.f90 | 17 ++++++++
gcc/testsuite/gfortran.dg/eor_handling_5.f90 | 19 +++++++++
gcc/testsuite/gfortran.dg/noadv_size.f90 | 11 +++++
gcc/testsuite/gfortran.dg/pad_no.f90 | 15 +++++++
libgfortran/ChangeLog | 25 +++++++++++
libgfortran/io/transfer.c | 45 ++++++++++++++++----
10 files changed, 174 insertions(+), 8 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/eor_handling_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/eor_handling_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/eor_handling_3.f90
create mode 100644 gcc/testsuite/gfortran.dg/eor_handling_4.f90
create mode 100644 gcc/testsuite/gfortran.dg/eor_handling_5.f90
create mode 100644 gcc/testsuite/gfortran.dg/noadv_size.f90
create mode 100644 gcc/testsuite/gfortran.dg/pad_no.f90
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 59255c0a50c2..a55aec878465 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.
diff --git a/gcc/testsuite/gfortran.dg/eor_handling_1.f90 b/gcc/testsuite/gfortran.dg/eor_handling_1.f90
new file mode 100644
index 000000000000..241f8a0fe4e0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eor_handling_1.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/eor_handling_2.f90 b/gcc/testsuite/gfortran.dg/eor_handling_2.f90
new file mode 100644
index 000000000000..5eb62f8a894b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eor_handling_2.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/eor_handling_3.f90 b/gcc/testsuite/gfortran.dg/eor_handling_3.f90
new file mode 100644
index 000000000000..4225e867a85f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eor_handling_3.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/eor_handling_4.f90 b/gcc/testsuite/gfortran.dg/eor_handling_4.f90
new file mode 100644
index 000000000000..300c10b820aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eor_handling_4.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/eor_handling_5.f90 b/gcc/testsuite/gfortran.dg/eor_handling_5.f90
new file mode 100644
index 000000000000..c116fb7bdeaf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eor_handling_5.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/noadv_size.f90 b/gcc/testsuite/gfortran.dg/noadv_size.f90
new file mode 100644
index 000000000000..a3a88b18ca72
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/noadv_size.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/pad_no.f90 b/gcc/testsuite/gfortran.dg/pad_no.f90
new file mode 100644
index 000000000000..c023adec815e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pad_no.f90
@@ -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
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 46fc3b3dedf8..fcb4ff3ae883 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -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>
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index f86a85272458..77e943964d8a 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -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;
--
GitLab