ref: 616c0d990146beeaac1d83b42b75a77067291f9c
dir: /tests/path.zuo/
#lang zuo (require "harness.zuo") (alert "paths") (check (path-string? "x")) (check (path-string? "") #f) (check (path-string? "xy\0z") #f) (check (path-string? 'apple) #f) (define unix? (eq? (hash-ref (runtime-env) 'system-type) 'unix)) (check (build-path "x" "y") (if unix? "x/y" "x\\y")) (check (build-path "." "y") "y") (check (build-raw-path "." "y") (if unix? "./y" ".\\y")) (check (build-path ".." "y") (if unix? "../y" "..\\y")) (check (build-path "x" ".") "x") (check (build-raw-path "x" ".") (if unix? "x/." "x\\.")) (check (build-path "x" "..") ".") (check (build-raw-path "x" "..") (if unix? "x/.." "x\\..")) (check (build-path "x/y/z/./.." "..") "x/") (check (build-raw-path "x/y/z/./.." "..") (if unix? "x/y/z/./../.." "x/y/z/./..\\..")) (check (build-path "x/y/./.." "..") ".") (check (build-path "x/y/./.." "../../..") (if unix? "../.." "..\\..")) (check (build-path "x/y/./.." "../q/../..") "..") (check (build-path "x/" "y") (if unix? "x/y" "x/y")) (check (build-path "x//" "y") (if unix? "x//y" "x//y")) (check (build-path "x\\" "y") (if unix? "x\\/y" "x\\y")) (check (build-path "x" "y/z") (if unix? "x/y/z" "x\\y\\z")) (check (build-raw-path "x" "y/z") (if unix? "x/y/z" "x\\y/z")) (check (build-path "x/y" "z") (if unix? "x/y/z" "x/y\\z")) (check (build-path "x/y/" "z") (if unix? "x/y/z" "x/y/z")) (check (build-path "/x" "z") (if unix? "/x/z" "/x\\z")) (check-arg-fail (build-path "" "z") "not a path string") (check-arg-fail (build-path "z" "") "not a path string") (check-arg-fail (build-path 0 "z") "not a path string") (check-arg-fail (build-path "z" 0) "not a path string") (check-arg-fail (build-path "z" "/x") "path is not relative") (check (build-path "x") "x") (check (build-path "x" "y" "z") (if unix? "x/y/z" "x\\y\\z")) (check (split-path "x/y") '("x/" . "y")) (check (split-path "x/y/") '("x/" . "y")) (check (split-path "x//y/") '("x//" . "y")) (check (split-path "x/y///") '("x/" . "y")) (check (split-path "x") '(#f . "x")) (check (split-path "x/") '(#f . "x")) (check (split-path "x//") '(#f . "x")) (check (split-path "x\\y") (if unix? '(#f . "x\\y") '("x\\" . "y"))) (check (split-path "/") '(#f . "/")) (check-arg-fail (split-path "") "not a path string") (check-arg-fail (split-path 0) "not a path string") (unless unix? (check (split-path "c:/") '(#f . "c:/")) (check (split-path "c:///") '(#f . "c:/")) (check (split-path "c:/x") '("c:/" . "x")) (check (split-path "c:/x/") '("c:/" . "x")) (check (split-path "c:\\") '(#f . "c:\\")) (check (split-path "c:\\x") '("c:\\" . "x")) (check (split-path "//mach/drive/") '(#f . "//mach/drive/")) (check (split-path "//mach/drive/\\\\") '(#f . "//mach/drive/")) (check (split-path "//mach/drive/z") '("//mach/drive/" . "z")) (check (split-path "\\\\mach\\drive\\") '(#f . "\\\\mach\\drive\\")) (check (split-path "\\\\mach\\drive\\z") '("\\\\mach\\drive\\" . "z")) (check (split-path "\\\\?\\c:\\elem") '("\\\\?\\c:\\" . "elem")) (check (split-path "\\\\?\\c:\\") '(#f . "\\\\?\\c:\\"))) (check (relative-path? "x/y")) (check (relative-path? "x/y/")) (check (relative-path? "/x/") #f) (check (relative-path? "/") #f) (check (relative-path? "\\x") unix?) (check-arg-fail (relative-path? "") "not a path string") (check-arg-fail (relative-path? 0) "not a path string") (check (path-string? (at-source "adjacent.txt"))) (check (at-source) (path-only (quote-module-path))) (check (procedure? at-source)) (check-fail (at-source . x) bad-stx) (check (simple-form-path "a//b//c/d/../f/g") (if unix? "a/b/c/f/g" "a\\b\\c\\f\\g")) (check (simple-form-path "a//b//c/d/.././../f/g") (if unix? "a/b/f/g" "a\\b\\f\\g")) (check (simple-form-path "../../a//b//c/d") (if unix? "../../a/b/c/d" "..\\..\\a\\b\\c\\d")) (check (find-relative-path "home/zuo/src" "home/zuo/src/private/optimize") (build-path "private" "optimize")) (check (find-relative-path "home/zuo/src" "home/zuo/lib") (build-path ".." "lib")) (check (find-relative-path "home/zuo/src" "home/zuo/src") ".") (check (find-relative-path "home/zuo/src" "tmp/cache") (build-path ".." ".." ".." "tmp" "cache")) (check (find-relative-path "." (build-path "tmp" "cache")) (build-path "tmp" "cache")) (check (find-relative-path "tmp/cache" ".") (build-path ".." "..")) (check (find-relative-path "../bin/tarm64osx/bin/" "main.o") (build-path ".." ".." ".." (cdr (split-path (hash-ref (runtime-env) 'dir))) "main.o")) (let ([l (reverse (explode-path (hash-ref (runtime-env) 'dir)))]) (when (> (length l) 3) (check (find-relative-path "../../../bin/tarm64osx/bin/" "../main.o") (build-path ".." ".." ".." (list-ref l 2) (list-ref l 1) "main.o")))) (check (find-relative-path "tmp/cache" "/home/zuo/src") "/home/zuo/src") (when unix? (check (find-relative-path "/home/zuo/src" "/home/zuo/src/private/optimize") "private/optimize") (check (find-relative-path "/home/zuo/src" "/home/zuo/lib") "../lib") (check (find-relative-path "/home/zuo/src" "/home/zuo/src") ".") (check (find-relative-path "/home/zuo/src" "/tmp/cache") "../../../tmp/cache")) (check (path-only "hello.txt") ".") (check (path-only ".") ".") (check (path-only "greeting/hello.txt") "greeting/") (check (path-only "in/greeting/hello.txt") "in/greeting/") (check (path-only "/") "/") (check (path-only "a/") "a/") (check (path-only "a\\") (if unix? "." "a\\")) (check (path-only "a/.") "a/.") (check (path-only "a/..") "a/..") (check-arg-fail (path-only 10) not-path) (check (file-name-from-path "hello.txt") "hello.txt") (check (file-name-from-path ".") #f) (check (file-name-from-path "greeting/hello.txt") "hello.txt") (check (file-name-from-path "in/greeting/hello.txt") "hello.txt") (check (file-name-from-path "/") #f) (check (file-name-from-path "a/") #f) (check (file-name-from-path "a\\") (if unix? "a\\" #f)) (check (file-name-from-path "a/.") #f) (check (file-name-from-path "a/..") #f) (check-arg-fail (file-name-from-path 10) not-path) (check (path-replace-extension "a.c" ".o") "a.o") (check (path-replace-extension "p/a.c" ".o") (build-path "p/a.o")) (check (path-replace-extension "p/.rc" ".o") (build-path "p/.rc.o")) (check-arg-fail (path-replace-extension 10 "x") not-path) (check-arg-fail (path-replace-extension "x" 10) not-string)