Hello, again.
Mario did some serious testing on Windows, and found yet more problems with the
changed
way of normalizing pathnames for UNIX/Windows. As we generate shell-commands
for both
UNIX and Windows (each with their own weird and obscure quoting behaviour),
this had
a number of repercussions.
Attached yet another variant of the patch.
felix
From fc9b051b9ecb4598e79a3edddb683e5daf632d32 Mon Sep 17 00:00:00 2001
From: felix <fe...@call-with-current-continuation.org>
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
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
