From fc9b051b9ecb4598e79a3edddb683e5daf632d32 Mon Sep 17 00:00:00 2001 From: felix Date: Wed, 11 Nov 2015 14:12:57 +0100 Subject: [PATCH] On UNIX-based systems, only accept "/" as path-separator. Windows still allows "/" and "\" (as does the Windows file-APIs) --- chicken-install.scm | 9 ++- csc.scm | 65 ++++++++++--------- files.scm | 31 +++++++--- tests/path-tests.scm | 151 +++++++++++++++++++++++++++++++++++---------- tests/test-find-files.scm | 55 +++++++++++------ 5 files changed, 217 insertions(+), 94 deletions(-) diff --git a/chicken-install.scm b/chicken-install.scm index 3b3e0ea..bc23c9d 100644 --- a/chicken-install.scm +++ b/chicken-install.scm @@ -513,6 +513,11 @@ (and (not (any loop (cdr p))) (fail))) (else (error "invalid `platform' property" name (cadr platform)))))))) + (define (back-slash->forward-slash path) + (if *windows-shell* + (string-translate path #\\ #\/) + path)) + (define (make-install-command egg-name egg-version dep?) (conc *csi* @@ -535,12 +540,12 @@ (let ((prefix (get-prefix))) (if prefix (sprintf " -e \"(destination-prefix \\\"~a\\\")\"" - (normalize-pathname prefix 'unix)) + (back-slash->forward-slash (normalize-pathname prefix))) "")) (let ((prefix (get-prefix #t))) (if prefix (sprintf " -e \"(runtime-prefix \\\"~a\\\")\"" - (normalize-pathname prefix 'unix)) + (back-slash->forward-slash (normalize-pathname prefix))) "")) (if (pair? *csc-features*) (sprintf " -e \"(extra-features '~s)\"" *csc-features*) diff --git a/csc.scm b/csc.scm index 54d29e2..1e5b19b 100644 --- a/csc.scm +++ b/csc.scm @@ -63,6 +63,7 @@ (define-foreign-variable BINARY_VERSION int "C_BINARY_VERSION") (define-foreign-variable POSTINSTALL_PROGRAM c-string "C_INSTALL_POSTINSTALL_PROGRAM") +(define windows-shell WINDOWS_SHELL) ;;; Parameters: @@ -84,23 +85,30 @@ (define cross-chicken (##sys#fudge 39)) (define (prefix str dir default) - (if chicken-prefix - (make-pathname (list chicken-prefix dir) str) - default) ) + (quotewrap + (if chicken-prefix + (make-pathname (list chicken-prefix dir) str) + default) )) + +(define (back-slash->forward-slash path) + (if windows-shell + (string-translate path #\\ #\/) + path)) (define (quotewrap str) + (qs (back-slash->forward-slash (normalize-pathname str)))) + +(define (quotewrap-no-slash-trans str) (qs (normalize-pathname str))) (define home - (quotewrap - (prefix "" "share" (if host-mode INSTALL_SHARE_HOME TARGET_SHARE_HOME)))) + (prefix "" "share" (if host-mode INSTALL_SHARE_HOME TARGET_SHARE_HOME))) (define translator - (quotewrap - (prefix "chicken" "bin" - (make-pathname - INSTALL_BIN_HOME - CHICKEN_PROGRAM)))) + (prefix "chicken" "bin" + (make-pathname + INSTALL_BIN_HOME + CHICKEN_PROGRAM))) (define compiler (quotewrap (if host-mode INSTALL_CC TARGET_CC))) (define c++-compiler (quotewrap (if host-mode INSTALL_CXX TARGET_CXX))) @@ -116,7 +124,6 @@ (define shared-library-extension ##sys#load-dynamic-extension) (define default-translation-optimization-options '()) (define pic-options (if (or mingw cygwin) '("-DPIC") '("-fPIC" "-DPIC"))) -(define windows-shell WINDOWS_SHELL) (define generate-manifest #f) (define libchicken (string-append "lib" INSTALL_LIB_NAME)) @@ -215,11 +222,10 @@ (define default-library-files (list - (quotewrap - (prefix default-library "lib" - (string-append - (if host-mode INSTALL_LIB_HOME TARGET_LIB_HOME) - (string-append "/" default-library)))) )) + (prefix default-library "lib" + (string-append + (if host-mode INSTALL_LIB_HOME TARGET_LIB_HOME) + (string-append "/" default-library)))) ) (define default-shared-library-files (list (string-append "-l" (if host-mode INSTALL_LIB_NAME TARGET_LIB_NAME)))) @@ -240,10 +246,10 @@ (define builtin-compile-options (append - (if include-dir (list (conc "-I\"" include-dir "\"")) '()) + (if include-dir (list (conc "-I" include-dir)) '()) (cond ((get-environment-variable "CHICKEN_C_INCLUDE_PATH") => (lambda (path) - (map (cut string-append "-I\"" <> "\"") (string-split path ":;")))) + (map (cut string-append "-I" <>) (map quotewrap (string-split path ":;"))))) (else '())))) (define compile-only-flag "-c") @@ -263,25 +269,24 @@ (append (cond (elf (list - (conc "-L\"" library-dir "\"") - (conc " -Wl,-R\"" + (conc "-L" library-dir) + (conc " -Wl,-R" (if deployed "\\$ORIGIN" (prefix "" "lib" (if host-mode INSTALL_LIB_HOME - TARGET_RUN_LIB_HOME))) - "\"")) ) - (aix - (list (conc "-Wl,-R\"" library-dir "\""))) + TARGET_RUN_LIB_HOME)))))) + (aix + (list (conc "-Wl,-R\"" library-dir "\""))) (else - (list (conc "-L\"" library-dir "\"")))) + (list (conc "-L" library-dir)))) (if (and deployed (memq (software-version) '(freebsd openbsd netbsd))) (list "-Wl,-z,origin") '()) (cond ((get-environment-variable "CHICKEN_C_LIBRARY_PATH") => (lambda (path) - (map (cut string-append "-L\"" <> "\"") (string-split path ":;")))) + (map (cut string-append "-L" <>) (string-split path ":;")))) (else '())))) (define target-filename #f) @@ -575,8 +580,8 @@ EOF (sprintf "~A ~A ~A" (if windows-shell "move" "mv") - (quotewrap target-filename) - (quotewrap (string-append target-filename ".old"))))) + ((if windows-shell quotewrap-no-slash-trans quotewrap) target-filename) + ((if windows-shell quotewrap-no-slash-trans quotewrap) (string-append target-filename ".old"))))) (run-linking)) ) ] [else (let* ([arg (car args)] @@ -992,8 +997,8 @@ EOF (if windows-shell "copy /Y" "cp") - (quotewrap from) - (quotewrap to)))) + ((if windows-shell quotewrap-no-slash-trans quotewrap) from) + ((if windows-shell quotewrap-no-slash-trans quotewrap) to)))) (define (linker-options) (string-append diff --git a/files.scm b/files.scm index 59de961..1d96416 100644 --- a/files.scm +++ b/files.scm @@ -147,7 +147,7 @@ EOF (set! absolute-pathname-root (lambda (pn) (irregex-match rx pn))) (set! root-origin (lambda (rt) (and rt (irregex-match-substring rt 1)))) (set! root-directory (lambda (rt) (and rt (irregex-match-substring rt 2)))) ) - (let ((rx (irregex "([\\/\\\\]).*"))) + (let ((rx (irregex "(/).*"))) (set! absolute-pathname-root (lambda (pn) (irregex-match rx pn))) (set! root-origin (lambda (rt) #f)) (set! root-directory (lambda (rt) (and rt (irregex-match-substring rt 1)))) ) ) @@ -156,7 +156,10 @@ EOF (##sys#check-string pn 'absolute-pathname?) (irregex-match-data? (absolute-pathname-root pn)) ) -(define-inline (*char-pds? ch) (memq ch '(#\\ #\/))) +(define-inline (*char-pds? ch) + (if ##sys#windows-platform + (memq ch '(#\\ #\/)) + (eq? #\/ ch))) (define (chop-pds str) (and str @@ -171,7 +174,7 @@ EOF (define make-pathname) (define make-absolute-pathname) -(let () +(let ((pds (if ##sys#windows-platform "\\" "/"))) (define (conc-dirs dirs) (##sys#check-list dirs 'make-pathname) @@ -183,7 +186,7 @@ EOF (loop (cdr strs)) (string-append (chop-pds (car strs)) - "/" + pds (loop (cdr strs))) ) ) ) ) ) (define (canonicalize-dirs dirs) @@ -221,12 +224,16 @@ EOF (let ((dir (canonicalize-dirs dirs))) (if (absolute-pathname? dir) dir - (##sys#string-append "/"dir)) ) + (##sys#string-append pds dir)) ) file ext) ) ) ) (define decompose-pathname - (let* ([patt1 "^(.*[\\/\\\\])?([^\\/\\\\]+)(\\.([^\\/\\\\.]+))$"] - [patt2 "^(.*[\\/\\\\])?((\\.)?[^\\/\\\\]+)$"] + (let* ((patt1 (if ##sys#windows-platform + "^(.*[\\/\\\\])?([^\\/\\\\]+)(\\.([^\\/\\\\.]+))$" + "^(.*/)?([^/]+)(\\.([^/.]+))$")) + (patt2 (if ##sys#windows-platform + "^(.*[\\/\\\\])?((\\.)?[^\\/\\\\]+)$" + "^(.*/)?((\\.)?[^/]+)$")) [rx1 (irregex patt1)] [rx2 (irregex patt2)] [strip-pds @@ -361,6 +368,10 @@ EOF (else (cons part parts) ) ) ) (lambda (path #!optional (platform bldplt)) (let ((sep (if (eq? platform 'windows) #\\ #\/))) + (define (pds? c) + (if (eq? platform 'windows) + (memq c '(#\/ #\\)) + (eq? c #\/))) (##sys#check-string path 'normalize-pathname) (let ((len (##sys#size path)) (type #f) @@ -387,7 +398,7 @@ EOF (when drive (set! r (##sys#string-append drive r))) r)))) - ((*char-pds? (string-ref path i)) + ((pds? (string-ref path i)) (when (not type) (set! type (if (fx= i prev) 'abs 'rel))) (if (fx= i prev) @@ -397,7 +408,7 @@ EOF (addpart (##sys#substring path prev i) parts)))) ((and (null? parts) (char=? (string-ref path i) #\:) - (eq? 'windows platform)) + (eq? platform 'windows)) (set! drive (##sys#substring path 0 (fx+ i 1))) (loop (fx+ i 1) (fx+ i 1) '())) (else (loop (fx+ i 1) prev parts)) ) ) ) ) ) ) ) @@ -409,7 +420,7 @@ EOF (define split-directory (lambda (loc dir keep?) (##sys#check-string dir loc) - (string-split dir "/\\" keep?) ) ) + (string-split dir (if ##sys#windows-platform "/\\" "/") keep?) ) ) ;; Directory string or list only contains path-separators ;; and/or current-directory (".") names. diff --git a/tests/path-tests.scm b/tests/path-tests.scm index 6e66fa6..68ac902 100644 --- a/tests/path-tests.scm +++ b/tests/path-tests.scm @@ -36,7 +36,7 @@ (test "a" (normalize-pathname "a")) (test "a/" (normalize-pathname "a/" 'unix)) (test "a/b" (normalize-pathname "a/b" 'unix)) -(test "a/b" (normalize-pathname "a\\b" 'unix)) +(test "a\\b" (normalize-pathname "a\\b" 'unix)) (test "a\\b" (normalize-pathname "a\\b" 'windows)) (test "a\\b" (normalize-pathname "a/b" 'windows)) (test "a/b/" (normalize-pathname "a/b/" 'unix)) @@ -67,7 +67,11 @@ (assert (not (directory-null? "//foo//"))) (test '(#f "/" (".")) (receive (decompose-directory "/.//"))) -(test '(#f "/" #f) (receive (decompose-directory "///\\///"))) + +(if ##sys#windows-platform + (test '(#f "/" #f) (receive (decompose-directory "///\\///"))) + (test '(#f "/" ("\\")) (receive (decompose-directory "///\\///")))) + (test '(#f "/" ("foo")) (receive (decompose-directory "//foo//"))) (test '(#f "/" ("foo" "bar")) (receive (decompose-directory "//foo//bar"))) (test '(#f #f (".")) (receive (decompose-directory ".//"))) @@ -77,57 +81,140 @@ (test '(#f #f #f) (receive (decompose-pathname ""))) (test '("/" #f #f) (receive (decompose-pathname "/"))) -(test '("\\" #f #f) (receive (decompose-pathname "\\"))) + +(if ##sys#windows-platform + (test '("\\" #f #f) (receive (decompose-pathname "\\"))) + (test '(#f "\\" #f) (receive (decompose-pathname "\\")))) + (test '("/" "a" #f) (receive (decompose-pathname "/a"))) -(test '("\\" "a" #f) (receive (decompose-pathname "\\a"))) + +(if ##sys#windows-platform + (test '("\\" "a" #f) (receive (decompose-pathname "\\a"))) + (test '(#f "\\a" #f) (receive (decompose-pathname "\\a")))) + (test '("/" #f #f) (receive (decompose-pathname "///"))) -(test '("\\" #f #f) (receive (decompose-pathname "\\\\\\"))) + +(if ##sys#windows-platform + (test '("\\" #f #f) (receive (decompose-pathname "\\\\\\"))) + (test '(#f "\\\\\\" #f) (receive (decompose-pathname "\\\\\\")))) + (test '("/" "a" #f) (receive (decompose-pathname "///a"))) -(test '("\\" "a" #f) (receive (decompose-pathname "\\\\\\a"))) + +(if ##sys#windows-platform + (test '("\\" "a" #f) (receive (decompose-pathname "\\\\\\a"))) + (test '(#f "\\\\\\a" #f) (receive (decompose-pathname "\\\\\\a")))) + (test '("/a" "b" #f) (receive (decompose-pathname "/a/b"))) -(test '("\\a" "b" #f) (receive (decompose-pathname "\\a\\b"))) + +(if ##sys#windows-platform + (test '("\\a" "b" #f) (receive (decompose-pathname "\\a\\b"))) + (test '(#f "\\a\\b" #f) (receive (decompose-pathname "\\a\\b")))) + (test '("/a" "b" "c") (receive (decompose-pathname "/a/b.c"))) -(test '("\\a" "b" "c") (receive (decompose-pathname "\\a\\b.c"))) + +(if ##sys#windows-platform + (test '("\\a" "b" "c") (receive (decompose-pathname "\\a\\b.c"))) + (test '(#f "\\a\\b" "c") (receive (decompose-pathname "\\a\\b.c")))) + (test '("." "a" #f) (receive (decompose-pathname "./a"))) -(test '("." "a" #f) (receive (decompose-pathname ".\\a"))) + +(if ##sys#windows-platform + (test '("." "a" #f) (receive (decompose-pathname ".\\a"))) + (test '(#f ".\\a" #f) (receive (decompose-pathname ".\\a")))) + (test '("." "a" "b") (receive (decompose-pathname "./a.b"))) -(test '("." "a" "b") (receive (decompose-pathname ".\\a.b"))) + +(if ##sys#windows-platform + (test '("." "a" "b") (receive (decompose-pathname ".\\a.b"))) + (test '(#f ".\\a" "b") (receive (decompose-pathname ".\\a.b")))) + (test '("./a" "b" #f) (receive (decompose-pathname "./a/b"))) -(test '(".\\a" "b" #f) (receive (decompose-pathname ".\\a\\b"))) + +(if ##sys#windows-platform + (test '(".\\a" "b" #f) (receive (decompose-pathname ".\\a\\b"))) + (test '(#f ".\\a\\b" #f) (receive (decompose-pathname ".\\a\\b")))) + (test '(#f "a" #f) (receive (decompose-pathname "a"))) (test '(#f "a." #f) (receive (decompose-pathname "a."))) (test '(#f ".a" #f) (receive (decompose-pathname ".a"))) (test '("a" "b" #f) (receive (decompose-pathname "a/b"))) -(test '("a" "b" #f) (receive (decompose-pathname "a\\b"))) + +(if ##sys#windows-platform + (test '("a" "b" #f) (receive (decompose-pathname "a\\b"))) + (test '(#f "a\\b" #f) (receive (decompose-pathname "a\\b")))) + (test '("a" "b" #f) (receive (decompose-pathname "a///b"))) -(test '("a" "b" #f) (receive (decompose-pathname "a\\\\\\b"))) + +(if ##sys#windows-platform + (test '("a" "b" #f) (receive (decompose-pathname "a\\\\\\b"))) + (test '(#f "a\\\\\\b" #f) (receive (decompose-pathname "a\\\\\\b")))) + (test '("a/b" "c" #f) (receive (decompose-pathname "a/b/c"))) -(test '("a\\b" "c" #f) (receive (decompose-pathname "a\\b\\c"))) + +(if ##sys#windows-platform + (test '("a\\b" "c" #f) (receive (decompose-pathname "a\\b\\c"))) + (test '(#f "a\\b\\c" #f) (receive (decompose-pathname "a\\b\\c")))) + (test '("a/b/c" #f #f) (receive (decompose-pathname "a/b/c/"))) -(test '("a\\b\\c" #f #f) (receive (decompose-pathname "a\\b\\c\\"))) + +(if ##sys#windows-platform + (test '("a\\b\\c" #f #f) (receive (decompose-pathname "a\\b\\c\\"))) + (test '(#f "a\\b\\c\\" #f) (receive (decompose-pathname "a\\b\\c\\")))) + (test '("a/b/c" #f #f) (receive (decompose-pathname "a/b/c///"))) -(test '("a\\b\\c" #f #f) (receive (decompose-pathname "a\\b\\c\\\\\\"))) + +(if ##sys#windows-platform + (test '("a\\b\\c" #f #f) (receive (decompose-pathname "a\\b\\c\\\\\\"))) + (test '(#f "a\\b\\c\\\\\\" #f) (receive (decompose-pathname "a\\b\\c\\\\\\")))) + (test '(#f "a" "b") (receive (decompose-pathname "a.b"))) (test '("a.b" #f #f) (receive (decompose-pathname "a.b/"))) -(test '("a.b" #f #f) (receive (decompose-pathname "a.b\\"))) + +(if ##sys#windows-platform + (test '("a.b" #f #f) (receive (decompose-pathname "a.b\\"))) + (test '(#f "a" "b\\") (receive (decompose-pathname "a.b\\")))) + (test '(#f "a.b" "c") (receive (decompose-pathname "a.b.c"))) (test '(#f "a." "b") (receive (decompose-pathname "a..b"))) (test '(#f "a.." "b") (receive (decompose-pathname "a...b"))) (test '("a." ".b" #f) (receive (decompose-pathname "a./.b"))) -(test '("a." ".b" #f) (receive (decompose-pathname "a.\\.b"))) - -(test "x/y/z.q" (make-pathname "x/y" "z" "q")) -(test "x/y/z.q" (make-pathname "x/y" "z.q")) -(test "x/y/z.q" (make-pathname "x/y/" "z.q")) -(test "x/y/z.q" (make-pathname "x/y/" "z.q")) -(test "x/y/z.q" (make-pathname "x/y\\" "z.q")) -(test "x//y/z.q" (make-pathname "x//y/" "z.q")) -(test "x\\y/z.q" (make-pathname "x\\y" "z.q")) + +(if ##sys#windows-platform + (test '("a." ".b" #f) (receive (decompose-pathname "a.\\.b"))) + (test '(#f "a.\\" "b") (receive (decompose-pathname "a.\\.b")))) + +(cond (##sys#windows-platform + (test "x/y\\z.q" (make-pathname "x/y" "z" "q")) + (test "x/y\\z.q" (make-pathname "x/y" "z.q")) + (test "x/y\\z.q" (make-pathname "x/y/" "z.q")) + (test "x/y\\z.q" (make-pathname "x/y/" "z.q")) + (test "x/y\\z.q" (make-pathname "x/y\\" "z.q")) + (test "x//y\\z.q" (make-pathname "x//y/" "z.q")) + (test "x\\y\\z.q" (make-pathname "x\\y" "z.q"))) + (else + (test "x/y/z.q" (make-pathname "x/y" "z" "q")) + (test "x/y/z.q" (make-pathname "x/y" "z.q")) + (test "x/y/z.q" (make-pathname "x/y/" "z.q")) + (test "x/y/z.q" (make-pathname "x/y/" "z.q")) + (test "x/y\\/z.q" (make-pathname "x/y\\" "z.q")) + (test "x//y/z.q" (make-pathname "x//y/" "z.q")) + (test "x\\y/z.q" (make-pathname "x\\y" "z.q")))) + (test 'error (handle-exceptions _ 'error (make-pathname '(#f) "foo"))) + (test "/x/y/z" (make-pathname #f "/x/y/z")) -(test "/x/y/z" (make-pathname "/" "x/y/z")) -(test "/x/y/z" (make-pathname "/x" "/y/z")) -(test "/x/y/z" (make-pathname '("/") "x/y/z")) -(test "/x/y/z" (make-pathname '("/" "x") "y/z")) -(test "/x/y/z" (make-pathname '("/x" "y") "z")) -(test "/x/y/z/" (make-pathname '("/x" "y" "z") #f)) + +(cond (##sys#windows-platform + (test "\\x/y/z" (make-pathname "/" "x/y/z")) + (test "/x\\y/z" (make-pathname "/x" "/y/z")) + (test "\\x/y/z" (make-pathname '("/") "x/y/z")) + (test "\\x\\y/z" (make-pathname '("/" "x") "y/z")) + (test "/x\\y\\z" (make-pathname '("/x" "y") "z")) + (test "/x\\y\\z\\" (make-pathname '("/x" "y" "z") #f))) + (else + (test "/x/y/z" (make-pathname "/" "x/y/z")) + (test "/x/y/z" (make-pathname "/x" "/y/z")) + (test "/x/y/z" (make-pathname '("/") "x/y/z")) + (test "/x/y/z" (make-pathname '("/" "x") "y/z")) + (test "/x/y/z" (make-pathname '("/x" "y") "z")) + (test "/x/y/z/" (make-pathname '("/x" "y" "z") #f)))) diff --git a/tests/test-find-files.scm b/tests/test-find-files.scm index c3ef3e4..62fe5a0 100644 --- a/tests/test-find-files.scm +++ b/tests/test-find-files.scm @@ -24,14 +24,19 @@ (change-directory "find-files-test-dir") (cond-expand - ((and windows (not cygwin))) ; Cannot handle symlinks - (else (create-symbolic-link "dir-link-target" "dir-link-name"))) + ((and windows (not cygwin)) ; Cannot handle symlinks + (define (path lst) + (map (cut string-translate <> "/" "\\") lst)) ) + (else + (create-symbolic-link "dir-link-target" "dir-link-name") + (define (path lst) lst))) (test-begin "find-files") (test-equal "no keyword args" (find-files ".") - `("./foo/bar/baz" + (path + `("./foo/bar/baz" "./foo/bar" "./foo" "./dir-link-target/foo" @@ -41,11 +46,12 @@ ,@(cond-expand ((and windows (not cygwin)) '()) (else '("./dir-link-name"))) - "./file2") + "./file2")) file-list=?) (test-equal "dotfiles: #t" (find-files "." dotfiles: #t) + (path `("./foo/bar/baz/.quux" "./foo/bar/baz" "./foo/bar" @@ -58,12 +64,13 @@ ,@(cond-expand ((and windows (not cygwin)) '()) (else '("./dir-link-name"))) - "./file2") + "./file2")) file-list=?) (test-equal "follow-symlinks: #t" (find-files "." follow-symlinks: #t) - `("./foo/bar/baz" + (path + `("./foo/bar/baz" "./foo/bar" "./foo" "./dir-link-target/foo" @@ -75,12 +82,13 @@ (else '("./dir-link-name/foo" "./dir-link-name/bar" "./dir-link-name"))) - "./file2") + "./file2")) file-list=?) (test-equal "limit: 1" (find-files "." limit: 1) - `("./foo/bar" + (path + `("./foo/bar" "./foo" "./dir-link-target/foo" "./dir-link-target/bar" @@ -89,11 +97,12 @@ ,@(cond-expand ((and windows (not cygwin)) '()) (else '("./dir-link-name"))) - "./file2") + "./file2")) file-list=?) (test-equal "limit: 1 follow-symlinks: #t" (find-files "." limit: 1 follow-symlinks: #t) + (path `("./foo/bar" "./foo" "./dir-link-target/foo" @@ -105,11 +114,12 @@ (else '("./dir-link-name/foo" "./dir-link-name/bar" "./dir-link-name"))) - "./file2") + "./file2")) file-list=?) (test-equal "limit: 2" (find-files "." limit: 2) + (path `("./foo/bar/baz" "./foo/bar" "./foo" @@ -120,11 +130,12 @@ ,@(cond-expand ((and windows (not cygwin)) '()) (else '("./dir-link-name"))) - "./file2") + "./file2")) file-list=?) (test-equal "limit: 2 follow-symlinks: #t" (find-files "." limit: 2 follow-symlinks: #t) + (path `("./foo/bar/baz" "./foo/bar" "./foo" @@ -137,36 +148,39 @@ (else '("./dir-link-name/foo" "./dir-link-name/bar" "./dir-link-name"))) - "./file2") + "./file2")) file-list=?) (test-equal "test: (lambda (f) (directory? f))" (find-files "." test: (lambda (f) (directory? f))) - `("./foo/bar/baz" + (path + `("./foo/bar/baz" "./foo/bar" "./foo" "./dir-link-target" ,@(cond-expand ((and windows (not cygwin)) '()) - (else '("./dir-link-name")))) + (else '("./dir-link-name"))))) file-list=?) (test-equal "test: (lambda (f) (directory? f)) action: (lambda (f p) (cons (string-append \"--\" f) p))" (find-files "." test: (lambda (f) (directory? f)) action: (lambda (f p) (cons (string-append "--" f) p))) - `("--./foo/bar/baz" + (path + `("--./foo/bar/baz" "--./foo/bar" "--./foo" "--./dir-link-target" ,@(cond-expand ((and windows (not cygwin)) '()) - (else '("--./dir-link-name")))) + (else '("--./dir-link-name"))))) file-list=?) (test-equal "dotfiles: #t test: (lambda (f) (directory? f)) follow-symlinks: #t" (find-files "." dotfiles: #t test: (lambda (f) (directory? f)) follow-symlinks: #t) - `("./foo/bar/baz/.quux" + (path + `("./foo/bar/baz/.quux" "./foo/bar/baz" "./foo/bar" "./foo/.x" @@ -174,7 +188,7 @@ "./dir-link-target" ,@(cond-expand ((and windows (not cygwin)) '()) - (else '("./dir-link-name")))) + (else '("./dir-link-name"))))) file-list=?) (test-equal "dotfiles: #t test: (lambda (f) (directory? f)) follow-symlinks: #t limit: 1" @@ -183,13 +197,14 @@ test: (lambda (f) (directory? f)) follow-symlinks: #t limit: 1) - `("./foo/bar" + (path + `("./foo/bar" "./foo/.x" "./foo" "./dir-link-target" ,@(cond-expand ((and windows (not cygwin)) '()) - (else '("./dir-link-name")))) + (else '("./dir-link-name"))))) file-list=?) (test-end "find-files") -- 1.7.9.5