From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Sun, 12 Jan 2003 17:34:33 +0000 (+0000)
Subject: Fix #18711 and add test for it (and indeed tell on write
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0678cb22c235366e6443f8ba36afc299093d457c;p=p5sagit%2Fp5-mst-13.2.git

Fix #18711 and add test for it (and indeed tell on write
handles at all !

p4raw-id: //depot/perlio@18471
---

diff --git a/perlio.c b/perlio.c
index 98aca50..de6950b 100644
--- a/perlio.c
+++ b/perlio.c
@@ -3427,6 +3427,11 @@ PerlIOBuf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 	PerlIO_get_base(f);
     if (!(PerlIOBase(f)->flags & PERLIO_F_CANWRITE))
 	return 0;
+    if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) {
+    	if (PerlIO_flush(f) != 0) {
+	    return 0;
+	}
+    }	
     while (count > 0) {
 	SSize_t avail = b->bufsiz - (b->ptr - b->buf);
 	if ((SSize_t) count < avail)
@@ -3485,6 +3490,19 @@ PerlIOBuf_tell(pTHX_ PerlIO *f)
      * b->posn is file position where b->buf was read, or will be written
      */
     Off_t posn = b->posn;
+    if ((PerlIOBase(f)->flags & PERLIO_F_APPEND) && 
+        (PerlIOBase(f)->flags & PERLIO_F_WRBUF)) {
+#if 1
+    	/* As O_APPEND files are normally shared in some sense it is better
+	   to flush :
+	 */  	
+	PerlIO_flush(f);
+#else	
+        /* when file is NOT shared then this is sufficient */ 
+	PerlIO_seek(PerlIONext(f),0, SEEK_END);
+#endif
+	posn = b->posn = PerlIO_tell(PerlIONext(f));
+    }
     if (b->buf) {
 	/*
 	 * If buffer is valid adjust position by amount in buffer
diff --git a/t/io/tell.t b/t/io/tell.t
index 416b869..b3065d3 100755
--- a/t/io/tell.t
+++ b/t/io/tell.t
@@ -7,7 +7,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..23\n";
+print "1..27\n";
 
 $TST = 'tst';
 
@@ -97,3 +97,47 @@ if (tell(ether) == -1)  { print "ok 23\n"; } else { print "not ok 23\n"; }
 # something else.  ftell() on pipes, fifos, and sockets is defined to
 # return -1.
 
+my $written = "tell_write.txt";
+
+END { unlink($written) }
+
+close($tst);
+open($tst,">$written")  || die "Cannot open $written:$!";
+binmode $TST if $Is_Dosish;
+
+if (tell($tst) == 0) { print "ok 24\n"; } else { print "not ok 24\n"; }
+
+print $tst "fred\n";
+
+if (tell($tst) == 5) { print "ok 25\n"; } else { print "not ok 25\n"; }
+
+print $tst "more\n";
+
+if (tell($tst) == 10) { print "ok 26\n"; } else { print "not ok 26\n"; }
+
+close($tst);
+
+open($tst,"+>>$written")  || die "Cannot open $written:$!";
+binmode $TST if $Is_Dosish;
+
+if (0) 
+{
+ # :stdio does not pass these so ignore them for now 
+
+if (tell($tst) == 0) { print "ok 27\n"; } else { print "not ok 27\n"; }
+
+$line = <$tst>;
+
+if ($line eq "fred\n") { print "ok 29\n"; } else { print "not ok 29\n"; }
+
+if (tell($tst) == 5) { print "ok 30\n"; } else { print "not ok 30\n"; }
+
+}
+
+print $tst "xxxx\n";
+
+if (tell($tst) == 15) { print "ok 27\n"; } else { print "not ok 27\n"; }
+
+close($tst);
+
+