352.8 tests
svn: r4660
This commit is contained in:
Matthew Flatt
parent
1a994b9341
commit
a991b6b33c
|
|
@ -374,8 +374,10 @@
|
|||
(unless (equal? (build-path "a" "b") (build-path "a" 'same "b"))
|
||||
(test-path (full-path "a" "b") simplify-path (build-path "a" 'same "b")))
|
||||
(test-path (full-path "a" "b") simplify-path (build-path "a" 'same "noexistsdir" 'up "b"))
|
||||
(test-path (full-path "a" "b") simplify-path (build-path "a" 'same "noexistsdir" 'same 'up "b" 'same 'same))
|
||||
(test-path (full-path "a" "b") simplify-path (build-path 'same "noexistsdir" 'same 'up "a" 'same "b" 'same 'same)))
|
||||
(test-path (path->directory-path (full-path "a" "b"))
|
||||
simplify-path (build-path "a" 'same "noexistsdir" 'same 'up "b" 'same 'same))
|
||||
(test-path (path->directory-path (full-path "a" "b"))
|
||||
simplify-path (build-path 'same "noexistsdir" 'same 'up "a" 'same "b" 'same 'same)))
|
||||
(test (build-path "x" "y") simplify-path (build-path "x" "z" 'up "y") #f)
|
||||
(test (build-path 'up "x" "y") simplify-path (build-path 'up "x" "z" 'up "y") #f)
|
||||
(test (build-path 'up "x" "y") simplify-path (build-path 'up 'same "x" "z" 'up "y") #f)
|
||||
|
|
@ -460,12 +462,14 @@
|
|||
(test (string->path "\\\\?\\\\a") path->complete-path "\\a")
|
||||
)
|
||||
(parameterize ([current-directory "\\\\?\\d:\\foo"])
|
||||
(test (string->path "\\\\?\\d:\\") current-drive)
|
||||
(test (string->path "\\\\?\\d:\\a") path->complete-path "\\a")
|
||||
;; because it simplifies, \\?\ goes away
|
||||
(test (string->path "d:\\") current-drive)
|
||||
(test (string->path "d:\\a") path->complete-path "\\a")
|
||||
)
|
||||
(parameterize ([current-directory "\\\\?\\UNC\\foo\\bar\\baz"])
|
||||
(test (string->path "\\\\?\\UNC\\foo\\bar") current-drive)
|
||||
(test (string->path "\\\\?\\UNC\\foo\\bar\\a") path->complete-path "\\a")
|
||||
;; because it simplifies, \\?\ goes away
|
||||
(test (string->path "\\\\foo\\bar") current-drive)
|
||||
(test (string->path "\\\\foo\\bar\\a") path->complete-path "\\a")
|
||||
)
|
||||
(parameterize ([current-directory "\\\\?\\REL\\"])
|
||||
(test (string->path "\\\\?\\") current-drive)
|
||||
|
|
@ -475,7 +479,10 @@
|
|||
(test (string->path "\\\\?\\REL\\a\\\\") current-drive)
|
||||
(test (string->path "\\\\?\\REL\\a\\\\\\a") path->complete-path "\\a")
|
||||
)
|
||||
|
||||
|
||||
(test (bytes->path #"c:\\a") path->complete-path "\\a" "c:")
|
||||
(test (bytes->path #"\\\\foo\\bar\\a") path->complete-path "\\a" "\\\\foo\\bar\\a")
|
||||
|
||||
;; Build path collapses .. and . in added parts and cleans up slashes and trailers:
|
||||
(test (string->path "\\\\?\\c:\\a\\b") build-path "\\\\?\\c:\\a" 'same "b")
|
||||
(test (string->path "\\\\?\\c:\\a\\b") build-path "\\\\?\\c:\\a\\" 'same "b")
|
||||
|
|
@ -487,9 +494,9 @@
|
|||
(test (string->path "\\\\?\\c:\\a\\b\\c\\d\\f\\") build-path "\\\\?\\c:\\a" "b//c" "d//\\f///")
|
||||
(test (string->path "\\\\?\\c:\\a\\foo") build-path "\\\\?\\c:\\a" "foo... ")
|
||||
|
||||
(test (string->path "\\\\?\\REL\\a") build-path "." "\\\\?\\REL\\a")
|
||||
(test (string->path "\\\\?\\REL\\a") build-path 'same "\\\\?\\REL\\a")
|
||||
(test (string->path "\\\\?\\REL\\a") build-path "\\\\?\\REL\\a" 'same)
|
||||
(test (string->path "\\\\?\\REL\\\\a") build-path "." "\\\\?\\REL\\a")
|
||||
(test (string->path "\\\\?\\REL\\\\a") build-path 'same "\\\\?\\REL\\a")
|
||||
(test (string->path "\\\\?\\REL\\\\a\\") build-path "\\\\?\\REL\\a" 'same)
|
||||
(test (string->path ".") build-path "\\\\?\\REL\\a" 'up)
|
||||
(test (string->path "\\\\?\\REL\\\\apple") build-path "\\\\?\\REL\\a" 'up "apple")
|
||||
(test (string->path ".") build-path "\\\\?\\REL\\a" 'up 'same)
|
||||
|
|
@ -500,11 +507,26 @@
|
|||
(test (string->path "\\\\?\\REL\\..\\..") build-path "\\\\?\\REL\\.." 'up)
|
||||
(test (string->path "\\\\?\\REL\\..\\..\\..") build-path 'up "\\\\?\\REL\\.." 'up)
|
||||
(test (string->path "\\\\?\\REL\\..\\..\\\\..") build-path 'up "\\\\?\\REL\\.." "\\\\?\\REL\\\\..")
|
||||
(test (string->path "\\\\?\\REL\\..\\..\\") build-path 'up "\\\\?\\REL\\.." "\\\\?\\REL\\\\.." 'up)
|
||||
(test (string->path "\\\\?\\REL\\x") build-path "x/y" "\\\\?\\REL\\..")
|
||||
(test (string->path "\\\\?\\c:x\\") build-path "c:x/y" "\\\\?\\REL\\..")
|
||||
(test (string->path "\\\\?\\REL\\..\\..") build-path 'up "\\\\?\\REL\\.." "\\\\?\\REL\\\\.." 'up)
|
||||
(test (string->path "\\\\?\\REL\\\\..\\") build-path "\\\\?\\REL\\\\.." "\\\\?\\REL\\\\.." 'up)
|
||||
(test (string->path "\\\\?\\REL\\\\x\\") build-path "x/y" "\\\\?\\REL\\..")
|
||||
(test (string->path "\\\\?\\c:\\x\\") build-path "c:x/y" "\\\\?\\REL\\..")
|
||||
|
||||
(test (string->path "\\\\?\\UNC\\f\\g\\") build-path "//f/g/h" "\\\\?\\REL\\..")
|
||||
(test-values (list (string->path "\\\\?\\REL\\..")
|
||||
(string->path "\\\\?\\REL\\\\a")
|
||||
#f)
|
||||
(lambda () (split-path "\\\\?\\REL\\..\\a")))
|
||||
(test-values (list (string->path "\\\\?\\REL\\..")
|
||||
(string->path "\\\\?\\REL\\\\a")
|
||||
#f)
|
||||
(lambda () (split-path "\\\\?\\REL\\..\\\\a")))
|
||||
(test-values (list (string->path "\\\\?\\REL\\b\\")
|
||||
(string->path "\\\\?\\REL\\\\a")
|
||||
#f)
|
||||
(lambda () (split-path "\\\\?\\REL\\b\\a")))
|
||||
|
||||
(test (string->path "\\\\?\\UNC\\f\\g") build-path "//f/g/h" "\\\\?\\REL\\..")
|
||||
(test (string->path "\\\\?\\UNC\\f\\g\\h\\") build-path "//f/g/h/i" "\\\\?\\REL\\..")
|
||||
(test (string->path "\\\\?\\UNC\\f\\g\\h\\..") build-path "//f/g/h" "\\\\?\\REL\\\\..")
|
||||
(test (string->path "\\\\?\\UNC\\f\\g\\h\\..") build-path "//f/g//h" "\\\\?\\REL\\\\..")
|
||||
(test (string->path "\\\\?\\UNC\\f\\g\\i\\x") build-path "//f/g/h/../i" "\\\\?\\REL\\x")
|
||||
|
|
@ -519,9 +541,11 @@
|
|||
|
||||
;; Allow \\?\ as a drive to add an absolute path:
|
||||
(test (string->path "\\\\?\\c:\\b") build-path "\\\\?\\c:\\" "\\b")
|
||||
(test (string->path "\\\\?\\c:\\\\b") build-path "\\\\?\\c:\\\\" "\\b")
|
||||
(test (string->path "\\\\?\\c:\\b") build-path "\\\\?\\c:\\\\" "\\b")
|
||||
(test (string->path "\\\\?\\c:\\b\\") build-path "\\\\?\\c:\\\\" "\\b\\")
|
||||
(test (string->path "\\\\?\\UNC\\goo\\bar\\b") build-path "\\\\?\\UNC\\goo\\bar" "\\b")
|
||||
(test (string->path "\\\\?\\\\b") build-path "\\\\?\\" "\\b")
|
||||
(test (string->path "\\\\?\\\\b\\") build-path "\\\\?\\" "\\b\\")
|
||||
(err/rt-test (build-path "\\\\?\\c:" "\\b") exn:fail:contract?)
|
||||
|
||||
;; Don't allow path addition on bad \\?\ to change the root:
|
||||
|
|
@ -538,8 +562,11 @@
|
|||
(test (string->path "\\?\\") build-path "\\\\" "?\\")
|
||||
(test (string->path "\\?\\a") build-path "\\\\" "?" "a")
|
||||
(test (string->path "\\?\\a") build-path "\\\\?" "a")
|
||||
(test (string->path "\\?\\a\\") build-path "\\\\?" "a\\")
|
||||
(test (string->path "\\\\?\\\\c:") build-path "\\\\?\\" "\\\\?\\REL\\c:")
|
||||
(test (string->path "\\\\?\\\\c:\\a") build-path "\\\\?\\" "\\\\?\\REL\\c:\\a")
|
||||
(test (string->path "\\\\?\\\\REL\\b") build-path "\\\\?\\" "\\\\?\\REL\\REL\\b")
|
||||
(test (string->path "\\\\?\\\\host\\vol\\a\\") build-path "\\\\?\\" "\\\\?\\REL\\\\host\\vol\\a\\")
|
||||
|
||||
;; UNC paths can't have "?" for machine or "/" in machine part:
|
||||
(test (list (string->path "/?/") (string->path "x")) get-base "//?/x")
|
||||
|
|
@ -550,7 +577,7 @@
|
|||
(test (list (string->path "\\\\?\\") (string->path "\\\\?\\REL\\\\c:")) get-base "\\\\?\\c:")
|
||||
(test (list #f (string->path "\\\\?\\c:\\")) get-base "\\\\?\\c:\\")
|
||||
(test (list #f (string->path "\\\\?\\c:\\\\")) get-base "\\\\?\\c:\\\\")
|
||||
(test (list (string->path "\\\\?\\c:\\\\") (string->path "a")) get-base "\\\\?\\c:\\\\a")
|
||||
(test (list (string->path "\\\\?\\c:\\") (string->path "a")) get-base "\\\\?\\c:\\\\a")
|
||||
(test (list #f (string->path "\\\\?\\UNC\\mach\\vol")) get-base "\\\\?\\UNC\\mach\\vol")
|
||||
(test (list #f (string->path "\\\\?\\UNC\\mach\\\\vol")) get-base "\\\\?\\UNC\\mach\\\\vol")
|
||||
(test (list #f (string->path "\\\\?\\UNC\\\\mach\\vol")) get-base "\\\\?\\UNC\\\\mach\\vol")
|
||||
|
|
@ -559,7 +586,7 @@
|
|||
(test (list (string->path "\\\\?\\") (string->path "UNC")) get-base "\\\\?\\UNC\\")
|
||||
(test (list #f (string->path "\\\\?\\UNC\\\\")) get-base "\\\\?\\UNC\\\\")
|
||||
(test (list #f (string->path "\\\\?\\xyz\\\\")) get-base "\\\\?\\xyz\\\\")
|
||||
(test (list (string->path "\\\\?\\c:\\a\\\\\\") (string->path "b")) get-base "\\\\?\\c:\\a\\\\\\b\\")
|
||||
(test (list (string->path "\\\\?\\c:\\a\\\\") (string->path "b")) get-base "\\\\?\\c:\\a\\\\\\b\\")
|
||||
(test (list #f (string->path "\\\\?\\c:\\a\\\\\\")) get-base "\\\\?\\c:\\a\\\\\\")
|
||||
(test (list (string->path "\\\\?\\UNC\\") (string->path "\\\\?\\REL\\\\x/y")) get-base "\\\\?\\UNC\\x/y")
|
||||
(test (list #f (string->path "\\\\?\\UNC\\x\\y")) get-base "\\\\?\\UNC\\x\\y")
|
||||
|
|
@ -570,26 +597,67 @@
|
|||
(test (list (string->path "\\\\?\\c:\\y ") (string->path "z")) get-base "c:/../y /z")
|
||||
(test (list (string->path "../aux/") (string->path "z")) get-base "../aux/z")
|
||||
(test (list (string->path "../aux.m/") (string->path "z")) get-base "../aux.m/z")
|
||||
(test (list (string->path "../") (string->path "\\\\?\\REL\\\\aux.m")) get-base "../aux.m/")
|
||||
(test (list (string->path "..") (string->path "\\\\?\\REL\\\\aux.m")) get-base "../aux.m/")
|
||||
(test (list (string->path "c:/") (string->path "\\\\?\\REL\\\\aux.m")) get-base "c:/aux.m/")
|
||||
(test (list (string->path "c:/") (string->path "\\\\?\\REL\\\\aux.m.p")) get-base "c:/aux.m.p/")
|
||||
(test (list (string->path "c:/") (string->path "\\\\?\\REL\\\\aux:m")) get-base "c:/aux:m/")
|
||||
(test (list (string->path "../") (string->path "aux.m")) get-base "../aux.m")
|
||||
(test (list (string->path "..") (string->path "aux.m")) get-base "../aux.m")
|
||||
|
||||
;; simplify-path leaves path alone:
|
||||
;; simplify-path leaves literal . and .. alone:
|
||||
(test (string->path "\\\\?\\c:\\b\\.\\..\\a") simplify-path "\\\\?\\c:\\b\\.\\..\\a")
|
||||
(test (string->path "\\\\?\\c:\\B\\.\\..\\a") normal-case-path "\\\\?\\c:\\B\\.\\..\\a")
|
||||
(test (string->path "\\\\?\\UNC\\foo\\A") normal-case-path "\\\\?\\UNC\\foo\\A")
|
||||
|
||||
;; expand-path removes redundant backslashes:
|
||||
(test (string->path "\\\\?\\c:\\a\\b") expand-path "\\\\?\\c:\\\\a\\\\b")
|
||||
(test (string->path "\\\\?\\c:\\") expand-path "\\\\?\\c:\\\\")
|
||||
(test (string->path "\\\\?\\c:\\a\\\\") expand-path "\\\\?\\c:\\a\\\\")
|
||||
(test (string->path "\\\\?\\c:\\a\\b") expand-path "\\\\?\\c:\\a\\\\b")
|
||||
(test (string->path "\\\\?\\UNC\\a\\b\\c") expand-path "\\\\?\\UNC\\\\a\\b\\c")
|
||||
(test (string->path "\\\\?\\UNC\\a\\b\\c") expand-path "\\\\?\\UNC\\\\a\\b\\\\c")
|
||||
;; expand-path removes redundant backslashes, and
|
||||
(test (string->path "\\\\?\\\\UNC\\x\\y") expand-path "\\\\?\\\\UNC\\x\\y")
|
||||
(test (string->path "\\\\?\\") expand-path "\\\\?\\\\")
|
||||
(test (string->path "\\\\?\\c:\\") expand-path "\\\\?\\c:\\\\")
|
||||
|
||||
;; expand-path removes redundant backslashes, and
|
||||
;; simplify-path uses expand-path under Windows:
|
||||
(let ([go
|
||||
(lambda (expand-path)
|
||||
(test (string->path "c:\\") expand-path "c:")
|
||||
(test (string->path "C:/") expand-path "C://")
|
||||
(test (string->path "C:/a/") expand-path "C://a//")
|
||||
(test (string->path "\\\\?\\c:\\a\\.") expand-path "\\\\?\\c:\\\\a\\\\.")
|
||||
(test (string->path "\\\\?\\c:\\a\\\\") expand-path "\\\\?\\c:\\a\\\\")
|
||||
(test (string->path "\\\\?\\c:\\a\\.") expand-path "\\\\?\\c:\\a\\\\.")
|
||||
(test (string->path "\\\\?\\UNC\\a\\b\\.") expand-path "\\\\?\\UNC\\\\a\\b\\.")
|
||||
(test (string->path "\\\\?\\UNC\\a\\b\\.") expand-path "\\\\?\\UNC\\\\a\\b\\\\.")
|
||||
(test (string->path "\\\\?\\") expand-path "\\\\?\\\\"))])
|
||||
(go expand-path)
|
||||
(go simplify-path))
|
||||
|
||||
(test (bytes->path #"..") simplify-path "\\\\?\\REL\\..")
|
||||
(test (bytes->path #"..") simplify-path "\\\\?\\REL\\..\\")
|
||||
(test (bytes->path #"\\\\foo\\bar\\") expand-path "\\\\foo\\bar\\")
|
||||
(test (bytes->path #"\\\\foo\\bar") simplify-path "\\\\foo\\bar\\")
|
||||
(test (bytes->path #"\\\\foo\\bar") simplify-path "\\\\?\\UNC\\foo\\bar")
|
||||
(test (bytes->path #"\\\\foo\\bar") simplify-path "\\\\?\\UNC\\foo\\bar\\")
|
||||
(test (bytes->path #"\\\\?\\UNC\\foo\\bar\\..") simplify-path "\\\\?\\UNC\\foo\\bar\\..")
|
||||
(test (bytes->path #"\\\\?\\UNC\\foo\\bar\\..\\") simplify-path "\\\\?\\UNC\\foo\\bar\\..\\")
|
||||
(test (bytes->path #"a") simplify-path "\\\\?\\REL\\a")
|
||||
(test (bytes->path #"a") simplify-path "\\\\?\\REL\\\\a")
|
||||
(test (bytes->path #"a\\") simplify-path "\\\\?\\REL\\\\a\\")
|
||||
(test (bytes->path #"\\\\?\\REL\\\\a/") simplify-path "\\\\?\\REL\\\\a/")
|
||||
(test (bytes->path #"\\\\?\\REL\\\\..") simplify-path "\\\\?\\REL\\\\..")
|
||||
(test (bytes->path #"\\\\?\\REL\\\\..\\") simplify-path "\\\\?\\REL\\\\..\\")
|
||||
(test (bytes->path #"a \\b") simplify-path "\\\\?\\REL\\\\a \\b")
|
||||
(test (bytes->path #"\\\\?\\REL\\\\aux.bad\\b") simplify-path "\\\\?\\REL\\aux.bad\\b")
|
||||
(test (bytes->path #"\\\\?\\REL\\\\a\\b ") simplify-path "\\\\?\\REL\\a\\b ")
|
||||
(test (bytes->path #"\\\\?\\REL\\\\.\\b") simplify-path "\\\\?\\REL\\.\\b")
|
||||
(test (bytes->path #"\\\\?\\REL\\\\.") simplify-path "\\\\?\\REL\\.")
|
||||
(test (bytes->path #"\\\\?\\REL\\\\:\\b") simplify-path "\\\\?\\REL\\:\\b")
|
||||
(test (bytes->path #"\\\\?\\REL\\\\:") simplify-path "\\\\?\\REL\\:")
|
||||
(test (bytes->path #"\\\\?\\REL") simplify-path "\\\\?\\REL")
|
||||
(test (bytes->path #"C:\\a\\b") simplify-path "\\\\?\\C:\\a\\b")
|
||||
(test (bytes->path #"C:\\a") simplify-path "\\\\?\\C:\\a")
|
||||
(test (bytes->path #"\\\\?\\C:\\a ") simplify-path "\\\\?\\C:\\a ")
|
||||
(test (bytes->path #"\\\\?\\C:a\\b") simplify-path "\\\\?\\C:a\\b")
|
||||
(test (bytes->path #"\\\\?\\C:") simplify-path "\\\\?\\C:")
|
||||
(test (bytes->path #"\\\\?\\a\\y") simplify-path "\\\\?\\a\\y")
|
||||
(test (bytes->path #"\\\\?\\REL\\a\\y\\\\") simplify-path "\\\\?\\REL\\a\\y\\\\")
|
||||
(test (bytes->path #"\\\\?\\REL\\a\\\\\\y") simplify-path "\\\\?\\REL\\a\\\\\\y")
|
||||
|
||||
(let ([dir (build-path here "tmp78")])
|
||||
(unless (directory-exists? dir)
|
||||
|
|
@ -602,6 +670,81 @@
|
|||
|
||||
))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; ~ paths and other subtleties in Unix
|
||||
|
||||
(test (and (memq (system-type) '(unix macosx)) #t) absolute-path? "~")
|
||||
(when (absolute-path? "~")
|
||||
(test #t relative-path? "./~")
|
||||
(test (bytes->path #"./~") bytes->path-element #"~")
|
||||
(test #"~" path-element->bytes (bytes->path #"./~"))
|
||||
(test (bytes->path #"./~me") bytes->path-element #"~me")
|
||||
(test #"~me" path-element->bytes (bytes->path #"./~me"))
|
||||
(err/rt-test (path-element->bytes (bytes->path #"x/y")))
|
||||
(err/rt-test (path-element->bytes (bytes->path #"x/~me")))
|
||||
(err/rt-test (path-element->bytes (bytes->path #"/me")))
|
||||
(err/rt-test (path-element->bytes (bytes->path #"/")))
|
||||
(err/rt-test (bytes->path-element #"./~"))
|
||||
(err/rt-test (bytes->path-element #"x/y"))
|
||||
(err/rt-test (bytes->path-element #"/x"))
|
||||
(err/rt-test (bytes->path-element #"/"))
|
||||
(test (bytes->path #"~") simplify-path (bytes->path #"~"))
|
||||
(test (bytes->path #"~") simplify-path (bytes->path #"~/"))
|
||||
(test (bytes->path #"~") simplify-path (bytes->path #"~/."))
|
||||
(test (bytes->path #"./~") simplify-path (bytes->path #"./~"))
|
||||
(test (bytes->path #"./~/") simplify-path (bytes->path #"./~/"))
|
||||
(test (bytes->path #"~/../..") simplify-path (bytes->path #"~/../..") #f)
|
||||
(test (bytes->path #"~/..") simplify-path (bytes->path #"~/../x/..") #f)
|
||||
(test (bytes->path #"..") simplify-path (bytes->path #"../x/..") #f)
|
||||
(test (bytes->path #"x/") simplify-path (bytes->path #"x/~/..") #f)
|
||||
(test (bytes->path #".") simplify-path (bytes->path #"./") #f)
|
||||
(test (bytes->path #".") simplify-path (bytes->path #".//") #f)
|
||||
(test (bytes->path #"..") simplify-path (bytes->path #"../") #f)
|
||||
(test (bytes->path #"..") simplify-path (bytes->path #"..//") #f)
|
||||
(test (bytes->path #"..") simplify-path (bytes->path #"..//./") #f)
|
||||
(test (bytes->path #"x/") path->directory-path (bytes->path #"x"))
|
||||
(test (bytes->path #"x/") path->directory-path (bytes->path #"x/"))
|
||||
(test (bytes->path #"x/.") path->directory-path (bytes->path #"x/."))
|
||||
(test (bytes->path #"x/./") path->directory-path (bytes->path #"x/./"))
|
||||
(test (bytes->path #"x/..") path->directory-path (bytes->path #"x/.."))
|
||||
(test (bytes->path #"x/../") path->directory-path (bytes->path #"x/../"))
|
||||
(test (bytes->path #".") path->directory-path (bytes->path #"."))
|
||||
(test (bytes->path #"./") path->directory-path (bytes->path #"./"))
|
||||
(test (bytes->path #"..") path->directory-path (bytes->path #".."))
|
||||
(test (bytes->path #"../") path->directory-path (bytes->path #"../"))
|
||||
(test (bytes->path #"~") path->directory-path (bytes->path #"~"))
|
||||
(test (bytes->path #"~me") path->directory-path (bytes->path #"~me"))
|
||||
(test (bytes->path #"~/") path->directory-path (bytes->path #"~/"))
|
||||
(test (bytes->path #"~me/") path->directory-path (bytes->path #"~me/"))
|
||||
(test (bytes->path #"./~/") path->directory-path (bytes->path #"./~"))
|
||||
(test-values (list #f (bytes->path #"~me") #t) (lambda () (split-path (bytes->path #"~me"))))
|
||||
(test-values (list #f (bytes->path #"~me") #t) (lambda () (split-path (bytes->path #"~me/"))))
|
||||
(test-values (list 'relative (bytes->path #"./~me") #f) (lambda () (split-path (bytes->path #"./~me"))))
|
||||
(test-values (list 'relative (bytes->path #"./~me") #t) (lambda () (split-path (bytes->path #"./~me/"))))
|
||||
(test-values (list (bytes->path #"./.") (bytes->path #"./~me") #f) (lambda () (split-path (bytes->path #"././~me"))))
|
||||
(test-values (list 'relative (bytes->path #"./~me") #f) (lambda () (split-path (bytes->path #".//~me"))))
|
||||
(test-values (list (bytes->path #"y/x/") (bytes->path #"./~me") #f) (lambda () (split-path (bytes->path #"y/x/~me"))))
|
||||
(test-values (list (bytes->path #"y/x/") (bytes->path #"./~me") #f) (lambda () (split-path (bytes->path #"y//x//~me"))))
|
||||
(test-values (list (bytes->path #"y/x/.") (bytes->path #"./~me") #f) (lambda () (split-path (bytes->path #"y/x/./~me"))))
|
||||
(test-values (list (bytes->path #"x/") (bytes->path #"./~me") #f) (lambda () (split-path (bytes->path #"x/~me"))))
|
||||
(test-values (list (bytes->path #"x/") (bytes->path #"./~me") #t) (lambda () (split-path (bytes->path #"x/~me/"))))
|
||||
(test-values (list (bytes->path #"x/.") (bytes->path #"y") #f) (lambda () (split-path (bytes->path #"x/./y"))))
|
||||
(test-values (list (bytes->path #"x/..") (bytes->path #"y") #f) (lambda () (split-path (bytes->path #"x/../y"))))
|
||||
(test-values (list (bytes->path #"~me") (bytes->path #"y") #f) (lambda () (split-path (bytes->path #"~me/y"))))
|
||||
(test-values (list (bytes->path #"~me/y/") (bytes->path #"z") #f) (lambda () (split-path (bytes->path #"~me/y/z"))))
|
||||
(test (bytes->path #"/home/mflatt/~") build-path (bytes->path #"/home/mflatt") (bytes->path #"./~"))
|
||||
(test (bytes->path #"/home/mflatt/././~") build-path (bytes->path #"/home/mflatt") (bytes->path #"././~"))
|
||||
(test (bytes->path #"./~") build-path (bytes->path #"./~"))
|
||||
(let ([dir "tmp79"])
|
||||
(unless (directory-exists? dir)
|
||||
(make-directory dir))
|
||||
(close-output-port (open-output-file "tmp79/~me" 'replace))
|
||||
(test (list (bytes->path #"./~me")) directory-list dir)
|
||||
(delete-file (build-path "tmp79" (bytes->path #"./~me")))
|
||||
(delete-directory dir))
|
||||
(void))
|
||||
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -374,6 +374,12 @@
|
|||
|
||||
(test #t regexp? (readstr "#rx\".\""))
|
||||
(test '("abc") regexp-match #rx"a.." "123abcdef")
|
||||
(test #t pregexp? (readstr "#px\".\""))
|
||||
(test '("abc") regexp-match #px"a.." "123abcdef")
|
||||
(test #t byte-regexp? (readstr "#rx#\".\""))
|
||||
(test '(#"abc") regexp-match #rx#"a.." "123abcdef")
|
||||
(test #t byte-pregexp? (readstr "#px#\".\""))
|
||||
(test '(#"abc") regexp-match #px#"a.." "123abcdef")
|
||||
|
||||
(err/rt-test (readstr "#r") exn:fail:read:eof?)
|
||||
(err/rt-test (readstr "#rx") exn:fail:read:eof?)
|
||||
|
|
@ -381,6 +387,20 @@
|
|||
(err/rt-test (readstr "#ra") exn:fail:read?)
|
||||
(err/rt-test (readstr "#rxa") exn:fail:read?)
|
||||
(err/rt-test (readstr "#rx\"?\"") exn:fail:read?)
|
||||
(err/rt-test (readstr "#rx#") exn:fail:read:eof?)
|
||||
(err/rt-test (readstr "#rx#\"") exn:fail:read:eof?)
|
||||
(err/rt-test (readstr "#rx#a") exn:fail:read?)
|
||||
(err/rt-test (readstr "#rx#\"?\"") exn:fail:read?)
|
||||
(err/rt-test (readstr "#p") exn:fail:read:eof?)
|
||||
(err/rt-test (readstr "#px") exn:fail:read:eof?)
|
||||
(err/rt-test (readstr "#px\"") exn:fail:read:eof?)
|
||||
(err/rt-test (readstr "#pa") exn:fail:read?)
|
||||
(err/rt-test (readstr "#pxa") exn:fail:read?)
|
||||
(err/rt-test (readstr "#px\"?\"") exn:fail:read?)
|
||||
(err/rt-test (readstr "#px#") exn:fail:read:eof?)
|
||||
(err/rt-test (readstr "#px#\"") exn:fail:read:eof?)
|
||||
(err/rt-test (readstr "#px#a") exn:fail:read?)
|
||||
(err/rt-test (readstr "#px#\"?\"") exn:fail:read?)
|
||||
|
||||
(test 2 vector-length (readstr "#2()"))
|
||||
(test 0 vector-ref (readstr "#2()") 1)
|
||||
|
|
|
|||
|
|
@ -142,66 +142,71 @@
|
|||
#"?"
|
||||
#"+"))
|
||||
|
||||
(map (lambda (p)
|
||||
(let ([name (car p)]
|
||||
[predicate (cdr p)]
|
||||
[mk (lambda (name extra not? star?)
|
||||
(byte-pregexp
|
||||
(string->bytes/latin-1
|
||||
(format "[~a~a[:~a:]]~a"
|
||||
(if not? "^" "")
|
||||
(if extra extra "")
|
||||
name
|
||||
(if star? "*" "")))))])
|
||||
(let ([try
|
||||
(lambda (extra)
|
||||
(let ([b (mk name extra #f #f)]
|
||||
[not-b (mk name extra #t #f)]
|
||||
[b* (mk name extra #f #t)]
|
||||
[not-b* (mk name extra #t #t)])
|
||||
(let loop ([c 0])
|
||||
(unless (= c 128)
|
||||
(let ([in? (or (and extra
|
||||
(= c (char->integer extra)))
|
||||
(predicate (integer->char c)))])
|
||||
(test (if in? (list (bytes c)) #f)
|
||||
regexp-match
|
||||
b
|
||||
(bytes c))
|
||||
(test (if in? (list (bytes c c)) (list (bytes)))
|
||||
regexp-match
|
||||
b*
|
||||
(bytes c c))
|
||||
(test (if in? #f (list (bytes c)))
|
||||
regexp-match
|
||||
not-b
|
||||
(bytes c))
|
||||
(test (if in? (list (bytes)) (list (bytes c c)))
|
||||
regexp-match
|
||||
not-b*
|
||||
(bytes c c))
|
||||
(loop (add1 c)))))
|
||||
(test #f regexp-match b (bytes 128))
|
||||
(test (list (bytes)) regexp-match b* (bytes 128 128))
|
||||
(test (list (bytes 128)) regexp-match not-b (bytes 128))
|
||||
(test (list (bytes 128 128)) regexp-match not-b* (bytes 128 128))))])
|
||||
(try #f)
|
||||
(try #\377)
|
||||
(unless (predicate #\x)
|
||||
(try #\x))
|
||||
(unless (predicate #\space)
|
||||
(try #\space))
|
||||
(unless (predicate #\000)
|
||||
(try #\000))
|
||||
(unless (predicate #\002)
|
||||
(try #\002)))))
|
||||
(list
|
||||
(cons "alpha" char-alphabetic?)
|
||||
(cons "alnum" (lambda (x)
|
||||
(or (char-alphabetic? x)
|
||||
(char-numeric? x))))
|
||||
))
|
||||
|
||||
(map (lambda (as-string?)
|
||||
(map (lambda (p)
|
||||
(let ([name (car p)]
|
||||
[predicate (cdr p)]
|
||||
[mk (lambda (name extra not? star?)
|
||||
((if as-string? pregexp byte-pregexp)
|
||||
((if as-string? values string->bytes/latin-1)
|
||||
(format "[~a~a[:~a:]]~a"
|
||||
(if not? "^" "")
|
||||
(if extra extra "")
|
||||
name
|
||||
(if star? "*" "")))))]
|
||||
[-bytes (if as-string?
|
||||
(lambda l
|
||||
(bytes->string/latin-1 (apply bytes l)))
|
||||
bytes)])
|
||||
(let ([try
|
||||
(lambda (extra)
|
||||
(let ([b (mk name extra #f #f)]
|
||||
[not-b (mk name extra #t #f)]
|
||||
[b* (mk name extra #f #t)]
|
||||
[not-b* (mk name extra #t #t)])
|
||||
(let loop ([c 0])
|
||||
(unless (= c 128)
|
||||
(let ([in? (or (and extra
|
||||
(= c (char->integer extra)))
|
||||
(predicate (integer->char c)))])
|
||||
(test (if in? (list (-bytes c)) #f)
|
||||
regexp-match
|
||||
b
|
||||
(-bytes c))
|
||||
(test (if in? (list (-bytes c c)) (list (-bytes)))
|
||||
regexp-match
|
||||
b*
|
||||
(-bytes c c))
|
||||
(test (if in? #f (list (-bytes c)))
|
||||
regexp-match
|
||||
not-b
|
||||
(-bytes c))
|
||||
(test (if in? (list (-bytes)) (list (-bytes c c)))
|
||||
regexp-match
|
||||
not-b*
|
||||
(-bytes c c))
|
||||
(loop (add1 c)))))
|
||||
(test #f regexp-match b (-bytes 128))
|
||||
(test (list (-bytes)) regexp-match b* (-bytes 128 128))
|
||||
(test (list (-bytes 128)) regexp-match not-b (-bytes 128))
|
||||
(test (list (-bytes 128 128)) regexp-match not-b* (-bytes 128 128))))])
|
||||
(try #f)
|
||||
(try #\377)
|
||||
(unless (predicate #\x)
|
||||
(try #\x))
|
||||
(unless (predicate #\space)
|
||||
(try #\space))
|
||||
(unless (predicate #\000)
|
||||
(try #\000))
|
||||
(unless (predicate #\002)
|
||||
(try #\002)))))
|
||||
(list
|
||||
(cons "alpha" char-alphabetic?)
|
||||
(cons "alnum" (lambda (x)
|
||||
(or (char-alphabetic? x)
|
||||
(char-numeric? x))))
|
||||
)))
|
||||
'(#f #t))
|
||||
|
||||
(test '("app\u039Be") regexp-match #px"(?i:app\u039Be)" "app\u039Be")
|
||||
(test '("app\u039Be") regexp-match #px"(?i:app\u03BBe)" "app\u039Be")
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user