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 (file)
--- 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 (executable)
--- 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);
+
+