[3.4 PATCH] Fix PR libf2c/17636

[Eric Botcazou <ebotcazou at libertysurf dot fr>]

Hi,

The PR is about a problem that apparently has been present on Solaris since 
2.95 at least.  The testcase is:

      program readfail
      character*30 str
      
      n=0
      open (10,file='READFAIL.IN')
 10   write(*,*)'Reading'
      read (10,'(A)',end=20,err=90)str
      n=n+1
      write(*,*)n
      goto 10
 20   continue
      write(*,*)'Writing'
      write(10,*)n+1
      write(*,*)'Closing'
      close(10)
      write(*,*)'Done'
      stop

 90   write(*,*) 'Error reading'
      stop
      end


The bug occurs on closing the file:
 Closing
endfile: truncation failed in endfile
apparent state: unit 6 (unnamed)
last format: list io
lately writing sequential formatted external IO
Abort

The problem occurs in t_runc: the call to FTELL

loc = FTELL (bf = b->ufd);

returns -1L (error) but 'loc' is later passed to ftruncate

  rc = ftruncate (fileno (b->ufd), loc);

which returns error too, thus triggering

  if (rc)
    err (a->aerr, 111, "endfile");


However, the problem originates in the program reading until EOF is reached 
and then appending new characters from there.  It looks like Solaris doesn't 
like that and ftell returns -1 as soon as one character has been tentatively 
written.

The proposed fix to invoke fseek between the reading and the writing.  This is 
not required according to the C99 Standard but this really helps here.

Tested on sparc-sun-solaris2.[89] and amd64-mandrake-linux-gnu.

Is it possible to add this kind of testcase to the testsuite?


2004-12-17  Eric Botcazou  <ebotcazou@libertysurf.fr>

	PR libf2c/17636
	* libI77/err.c (f__nowwriting): Call fseek if end-of-file.


-- 
Eric Botcazou

Index: err.c
===================================================================
RCS file: /cvs/gcc/gcc/libf2c/libI77/Attic/err.c,v
retrieving revision 1.12
diff -u -p -r1.12 err.c
--- err.c	2 Jun 2002 13:01:11 -0000	1.12
+++ err.c	17 Dec 2004 11:06:37 -0000
@@ -239,7 +239,13 @@ f__nowwriting (unit * x)
   extern char *f__w_mode[];
 
   if (x->urw & 2)
-    goto done;
+    {
+      /* Not required according to C99 7.19.5.3, but
+	 this really helps on Solaris.  */
+      if (feof (x->ufd))
+	FSEEK (x->ufd, 0, SEEK_END);
+      goto done;
+    }
   if (!x->ufnm)
     goto cantwrite;
   ufmt = x->url ? 0 : x->ufmt;