>From 83337202ba58588dfe427f43569c882de34f80f0 Mon Sep 17 00:00:00 2001 From: Evan Hanson Date: Tue, 10 Oct 2017 21:45:56 +1300 Subject: [PATCH] Add a more thorough workaround for stat() issues on MinGW MinGW's stat(2) syscall is badly behaved with respect to trailing slashes in pathnames, so we add a drop-in replacement ("C_stat") in chicken.h that smoothes over these problems on MinGW, MSYS, and MSYS2. In particular, this replacement will strip trailing slashes and retry when the built-in stat(2) yields ENOENT, since paths like "//" will cause MinGW's version to fail (incorrectly). It will also return -1 when given a non-directory pathname that includes a trailing slash, since the built-in version will actually succeed in this case when it should instead fail with errno set to ENOTDIR. Note that we must attempt to stat the given filename at least once before stripping slashes, since there are some valid paths (e.g. "C:/" or "\\") that require them to be present in order for the call to succeed. The preexisting stat macros in posix*.scm have been given "u" and "i" prefixes to avoid name collisions with the new wrapper, and to indicate their proper usage. This commit also adds a test script to check for these and other similar problems on all platforms. The invocation of this script in runtests.sh is a bit unusual, passing "//" as an argument instead of "/" when running under MSYS*. This is because a single "/" will expand to the MSYS installation's root directory, for example "C:/MinGW/msys/1.0"; the second slash effectively escapes the first and disables this behaviour. --- chicken.h | 43 ++++++++++++++++++++++++++++++ distribution/manifest | 1 + library.scm | 24 ++--------------- posix-common.scm | 21 ++++++--------- posixunix.scm | 2 +- posixwin.scm | 4 +-- runtime.c | 3 +-- tests/file-access-tests.scm | 65 +++++++++++++++++++++++++++++++++++++++++++++ tests/posix-tests.scm | 3 ++- tests/runtests.bat | 6 +++++ tests/runtests.sh | 8 ++++++ 11 files changed, 139 insertions(+), 41 deletions(-) create mode 100644 tests/file-access-tests.scm diff --git a/chicken.h b/chicken.h index 57f99a2c..3aeb0028 100644 --- a/chicken.h +++ b/chicken.h @@ -120,6 +120,7 @@ /* Headers */ #include +#include #include #include #include @@ -132,6 +133,7 @@ #include #include #include +#include /* Byteorder in machine word */ @@ -3490,6 +3492,47 @@ inline static size_t C_strlcat(char *dst, const char *src, size_t sz) } #endif +/* + * MinGW's stat() is less than ideal in a couple of ways, so we provide a + * wrapper that: + * + * 1. Strips all trailing slashes and retries on failure, since stat() will + * yield ENOENT when given two (on MSYS) or more (on MinGW and MSYS2). + * 2. Fails with ENOTDIR when given a path to a non-directory file that ends + * in a slash, since in this case MinGW's stat() will succeed but return a + * non-directory mode in buf.st_mode. + */ +#ifndef __MINGW32__ +# define C_stat stat +#else +inline static int C_stat(const char *path, struct stat *buf) +{ + size_t len = C_strlen(path); + char slash = len && C_strchr("\\/", path[len - 1]), *str; + + if(stat(path, buf) == 0) + goto dircheck; + + if(slash && errno == ENOENT) { + C_strlcpy((str = C_alloca(len + 1)), path, len + 1); + while(len > 1 && C_strchr("\\/", path[--len])) + str[len] = '\0'; + if(stat(str, buf) == 0) + goto dircheck; + } + + return -1; + +dircheck: + if(slash && !S_ISDIR(buf->st_mode)) { + errno = ENOTDIR; + return -1; + } + + return 0; +} +#endif + /* Safe realpath usage depends on a reliable PATH_MAX. */ #ifdef PATH_MAX # define C_realpath realpath diff --git a/distribution/manifest b/distribution/manifest index f84ecf28..5ce932d5 100644 --- a/distribution/manifest +++ b/distribution/manifest @@ -146,6 +146,7 @@ tests/embedded3.c tests/embedded4.scm tests/executable-tests.scm tests/condition-tests.scm +tests/file-access-tests.scm tests/fixnum-tests.scm tests/numbers-string-conversion-tests.scm tests/numbers-test.scm diff --git a/library.scm b/library.scm index d75635a9..584e539c 100644 --- a/library.scm +++ b/library.scm @@ -2749,20 +2749,6 @@ EOF (define (##sys#port-data port) (##sys#slot port 9)) (define (##sys#set-port-data! port data) (##sys#setslot port 9 data)) -(define ##sys#platform-fixup-pathname - (let* ([bp (string->symbol ((##core#primitive "C_build_platform")))] - [fixsuffix (eq? bp 'mingw32)]) - (lambda (name) - (if fixsuffix - (let ([end (fx- (##sys#size name) 1)]) - (if (fx>= end 0) - (let ([c (##core#inline "C_subchar" name end)]) - (if (or (eq? c #\\) (eq? c #\/)) - (##sys#substring name 0 end) - name) ) - name) ) - name) ) ) ) - (define open-input-file) (define open-output-file) (define close-input-port) @@ -2858,17 +2844,11 @@ EOF (define (file-exists? name) (##sys#check-string name 'file-exists?) - (and (##sys#file-exists? - (##sys#platform-fixup-pathname name) - #f #f 'file-exists?) - name) ) + (and (##sys#file-exists? name #f #f 'file-exists?) name)) (define (directory-exists? name) (##sys#check-string name 'directory-exists?) - (and (##sys#file-exists? - (##sys#platform-fixup-pathname name) - #f #t 'directory-exists?) - name) ) + (and (##sys#file-exists? name #f #t 'directory-exists?) name)) (define (##sys#flush-output port) ((##sys#slot (##sys#slot port 2) 5) port) ; flush-output diff --git a/posix-common.scm b/posix-common.scm index b0a8b5be..553725a9 100644 --- a/posix-common.scm +++ b/posix-common.scm @@ -28,9 +28,6 @@ (foreign-declare #< -#include - -#include static int C_not_implemented(void); int C_not_implemented() { return -1; } @@ -41,8 +38,9 @@ static C_TLS struct stat C_statbuf; #define C_stat_type (C_statbuf.st_mode & S_IFMT) #define C_stat_perm (C_statbuf.st_mode & ~S_IFMT) -#define C_stat(fn) C_fix(stat((char *)C_data_pointer(fn), &C_statbuf)) -#define C_fstat(f) C_fix(fstat(C_unfix(f), &C_statbuf)) + +#define C_u_i_stat(fn) C_fix(C_stat((char *)C_data_pointer(fn), &C_statbuf)) +#define C_u_i_fstat(fd) C_fix(fstat(C_unfix(fd), &C_statbuf)) #ifndef S_IFSOCK # define S_IFSOCK 0140000 @@ -248,16 +246,13 @@ EOF (stat-mode S_IFIFO) (define (stat file link err loc) - (let ((r (cond ((fixnum? file) (##core#inline "C_fstat" file)) - ((port? file) (##core#inline "C_fstat" (port->fileno file))) + (let ((r (cond ((fixnum? file) (##core#inline "C_u_i_fstat" file)) + ((port? file) (##core#inline "C_u_i_fstat" (port->fileno file))) ((string? file) - (let ((path (##sys#make-c-string - (##sys#platform-fixup-pathname - file) - loc))) + (let ((path (##sys#make-c-string file loc))) (if link - (##core#inline "C_lstat" path) - (##core#inline "C_stat" path) ) ) ) + (##core#inline "C_u_i_lstat" path) + (##core#inline "C_u_i_stat" path)))) (else (##sys#signal-hook #:type-error loc "bad argument type - not a fixnum, port or string" file)) ) ) ) diff --git a/posixunix.scm b/posixunix.scm index 7f8bc239..5ac48082 100644 --- a/posixunix.scm +++ b/posixunix.scm @@ -149,7 +149,7 @@ static C_TLS struct stat C_statbuf; #define C_close(fd) C_fix(close(C_unfix(fd))) #define C_umask(m) C_fix(umask(C_unfix(m))) -#define C_lstat(fn) C_fix(lstat((char *)C_data_pointer(fn), &C_statbuf)) +#define C_u_i_lstat(fn) C_fix(lstat((char *)C_data_pointer(fn), &C_statbuf)) #define C_u_i_execvp(f,a) C_fix(execvp(C_data_pointer(f), (char *const *)C_c_pointer_vector_or_null(a))) #define C_u_i_execve(f,a,e) C_fix(execve(C_data_pointer(f), (char *const *)C_c_pointer_vector_or_null(a), (char *const *)C_c_pointer_vector_or_null(e))) diff --git a/posixwin.scm b/posixwin.scm index 704b2689..fecfc4e4 100644 --- a/posixwin.scm +++ b/posixwin.scm @@ -199,7 +199,7 @@ readdir(DIR * dir) #define C_getenventry(i) environ[ i ] -#define C_lstat(fn) C_stat(fn) +#define C_u_i_lstat(fn) C_u_i_stat(fn) #define C_u_i_execvp(f,a) C_fix(execvp(C_data_pointer(f), (const char *const *)C_c_pointer_vector_or_null(a))) #define C_u_i_execve(f,a,e) C_fix(execve(C_data_pointer(f), (const char *const *)C_c_pointer_vector_or_null(a), (const char *const *)C_c_pointer_vector_or_null(e))) @@ -577,7 +577,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime) /* Only stat if needed */ if (atime == C_SCHEME_FALSE || mtime == C_SCHEME_FALSE) { - if (stat(filename, &sb) == -1) return -1; + if (C_stat(filename, &sb) == -1) return -1; } if (atime == C_SCHEME_FALSE) { diff --git a/runtime.c b/runtime.c index 93460208..12471fdf 100644 --- a/runtime.c +++ b/runtime.c @@ -28,7 +28,6 @@ #include "chicken.h" #include -#include #include #include #include @@ -12580,7 +12579,7 @@ C_i_file_exists_p(C_word name, C_word file, C_word dir) struct stat buf; int res; - res = stat(C_c_string(name), &buf); + res = C_stat(C_c_string(name), &buf); if(res != 0) { switch(errno) { diff --git a/tests/file-access-tests.scm b/tests/file-access-tests.scm new file mode 100644 index 00000000..79682f2d --- /dev/null +++ b/tests/file-access-tests.scm @@ -0,0 +1,65 @@ +;; +;; Tests for file and directory access. +;; +;; These may seem silly, but some of them actually fail on MinGW without help. +;; + +(define / (car (command-line-arguments))) +(define // (string-append / /)) +(define /// (string-append / / /)) + +(assert (not (file-exists? ""))) +(assert (not (directory-exists? ""))) + +(assert (file-exists? /)) +(assert (file-exists? //)) +(assert (file-exists? ///)) + +(assert (directory-exists? /)) +(assert (directory-exists? //)) +(assert (directory-exists? ///)) + +(assert (file-exists? ".")) +(assert (file-exists? "..")) + +(assert (directory-exists? ".")) +(assert (directory-exists? "..")) + +(assert (file-exists? (string-append "." /))) +(assert (file-exists? (string-append "." //))) +(assert (file-exists? (string-append "." ///))) + +(assert (file-exists? (string-append ".." /))) +(assert (file-exists? (string-append ".." //))) +(assert (file-exists? (string-append ".." ///))) + +(assert (file-exists? (string-append ".." / "tests"))) +(assert (file-exists? (string-append ".." / "tests" /))) +(assert (file-exists? (string-append ".." / "tests" //))) +(assert (file-exists? (string-append ".." / "tests" ///))) + +(assert (directory-exists? (string-append "." /))) +(assert (directory-exists? (string-append "." //))) +(assert (directory-exists? (string-append "." ///))) + +(assert (directory-exists? (string-append ".." /))) +(assert (directory-exists? (string-append ".." //))) +(assert (directory-exists? (string-append ".." ///))) + +(assert (directory-exists? (string-append ".." / "tests"))) +(assert (directory-exists? (string-append ".." / "tests" /))) +(assert (directory-exists? (string-append ".." / "tests" //))) +(assert (directory-exists? (string-append ".." / "tests" ///))) + +(assert (file-exists? (program-name))) +(assert (not (directory-exists? (program-name)))) + +(assert (not (file-exists? (string-append (program-name) /)))) +(assert (not (file-exists? (string-append (program-name) //)))) +(assert (not (file-exists? (string-append (program-name) ///)))) + +(assert (not (directory-exists? (string-append (program-name) /)))) +(assert (not (directory-exists? (string-append (program-name) //)))) +(assert (not (directory-exists? (string-append (program-name) ///)))) + +(print "All tests passed for slash: " /) diff --git a/tests/posix-tests.scm b/tests/posix-tests.scm index 381b7ff7..706a8dff 100644 --- a/tests/posix-tests.scm +++ b/tests/posix-tests.scm @@ -39,7 +39,8 @@ (receive (in out pid) (process "../csi" '("-n" "-I" ".." "-e" "(write 'err (current-error-port)) (write 'ok)")) - (assert (equal? 'ok (read in)))) + (assert (equal? 'ok (read in))) + (newline (current-error-port))) (receive (in out pid err) (process* "../csi" '("-n" "-I" ".." "-e" diff --git a/tests/runtests.bat b/tests/runtests.bat index 2d25a98e..4f558326 100644 --- a/tests/runtests.bat +++ b/tests/runtests.bat @@ -460,6 +460,12 @@ if errorlevel 1 exit /b 1 a.out if errorlevel 1 exit /b 1 +echo ======================================== file access tests ... +%interpret% -s file-access-tests.scm / +if errorlevel 1 exit /b 1 +%interpret% -s file-access-tests.scm \ +if errorlevel 1 exit /b 1 + echo ======================================== find-files tests ... %interpret% -bnq test-find-files.scm if errorlevel 1 exit /b 1 diff --git a/tests/runtests.sh b/tests/runtests.sh index 752e6b74..05748810 100755 --- a/tests/runtests.sh +++ b/tests/runtests.sh @@ -363,6 +363,14 @@ echo "======================================== posix tests ..." $compile posix-tests.scm ./a.out +echo "======================================== file access tests ..." +if test -n "$MSYSTEM"; then + $interpret -s file-access-tests.scm // + $interpret -s file-access-tests.scm \\ +else + $interpret -s file-access-tests.scm / +fi + echo "======================================== find-files tests ..." $interpret -bnq test-find-files.scm -- 2.11.0