In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/d484df69ed26120321cdca989748cd4636b276bb?hp=4221d7c5eb104778a9335f0f89b12f122d99e425>

- Log -----------------------------------------------------------------
commit d484df69ed26120321cdca989748cd4636b276bb
Author: Tony Cook <[email protected]>
Date:   Wed Jun 10 09:48:09 2015 +1000

    [perl #125347] allow truncate to work on large files on Win32
    
    truncate($filename, $size) was using a simple PerlIO_open() to open
    the file, which on Win32 defaults to a text mode open.
    
    Unfortunately, on a text mode open(), MSVCRT attempts to seek to the
    end of file using only 32-bit offsets, which fails.
    
    For good measure, add in O_LARGEFILE if it's available, which may
    prevent similar issues on other platforms.
    
    Also, remove the erroneous SETERRNO() added by 375ed12a to the open
    failure branch, PerlLIO_open() should already set errno on failure, so
    we get sane error messages when the open fails.
-----------------------------------------------------------------------

Summary of changes:
 pp_sys.c | 16 ++++++++++++++--
 1 file changed, 14 insertions(+), 2 deletions(-)

diff --git a/pp_sys.c b/pp_sys.c
index 7c20f52..38537f3 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2304,10 +2304,22 @@ PP(pp_truncate)
                result = 0;
 #else
            {
-               const int tmpfd = PerlLIO_open(name, O_RDWR);
+                int mode = O_RDWR;
+                int tmpfd;
+
+#if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE)
+                mode |= O_LARGEFILE;   /* Transparently largefiley. */
+#endif
+#ifdef O_BINARY
+                /* On open(), the Win32 CRT tries to seek around text
+                 * files using 32-bit offsets, which causes the open()
+                 * to fail on large files, so open in binary mode.
+                 */
+                mode |= O_BINARY;
+#endif
+                tmpfd = PerlLIO_open(name, mode);
 
                if (tmpfd < 0) {
-                    SETERRNO(EBADF,RMS_IFI);
                    result = 0;
                } else {
                    if (my_chsize(tmpfd, len) < 0)

--
Perl5 Master Repository

Reply via email to