io: repair directory-list
for Windows
This commit is contained in:
parent
9e4ebd9196
commit
7abfdab35e
|
@ -23,6 +23,7 @@ GLOBALS = --no-global \
|
||||||
++global-ok "string->number?" \
|
++global-ok "string->number?" \
|
||||||
++global-ok "printable-regexp?" \
|
++global-ok "printable-regexp?" \
|
||||||
++global-ok do-global-print \
|
++global-ok do-global-print \
|
||||||
|
++global-ok simplify-path/dl \
|
||||||
++global-ok exec-file \
|
++global-ok exec-file \
|
||||||
++global-ok run-file \
|
++global-ok run-file \
|
||||||
++global-ok collects-dir \
|
++global-ok collects-dir \
|
||||||
|
|
|
@ -36,7 +36,9 @@
|
||||||
filesystem-root-list
|
filesystem-root-list
|
||||||
|
|
||||||
;; For the expander to register `maybe-raise-missing-module`:
|
;; For the expander to register `maybe-raise-missing-module`:
|
||||||
set-maybe-raise-missing-module!)
|
set-maybe-raise-missing-module!
|
||||||
|
;; To resolve a cycle with the definition of `simplify-path`
|
||||||
|
set-simplify-path-for-directory-list!)
|
||||||
|
|
||||||
(define/who (directory-exists? p)
|
(define/who (directory-exists? p)
|
||||||
(check who path-string? p)
|
(check who path-string? p)
|
||||||
|
@ -65,9 +67,18 @@
|
||||||
"")
|
"")
|
||||||
(host-> host-path)))))
|
(host-> host-path)))))
|
||||||
|
|
||||||
|
(define simplify-path/dl (lambda (p) p))
|
||||||
|
(define (set-simplify-path-for-directory-list! proc)
|
||||||
|
(set! simplify-path/dl proc))
|
||||||
|
|
||||||
(define/who (directory-list [p (current-directory)])
|
(define/who (directory-list [p (current-directory)])
|
||||||
(check who path-string? p)
|
(check who path-string? p)
|
||||||
(define host-path (->host p who '(read)))
|
(define host-path/initial (->host p who '(read)))
|
||||||
|
(define host-path (case (system-type)
|
||||||
|
[(windows)
|
||||||
|
;; Need to avoid "." and "..", so simplify
|
||||||
|
(->host (simplify-path/dl (host-> host-path/initial)) #f '())]
|
||||||
|
[else host-path/initial]))
|
||||||
(atomically
|
(atomically
|
||||||
(call-with-resource
|
(call-with-resource
|
||||||
(rktio_directory_list_start rktio host-path)
|
(rktio_directory_list_start rktio host-path)
|
||||||
|
|
|
@ -106,6 +106,8 @@
|
||||||
(path->directory-path simpler-p)
|
(path->directory-path simpler-p)
|
||||||
simpler-p)])]))
|
simpler-p)])]))
|
||||||
|
|
||||||
|
(void (set-simplify-path-for-directory-list! simplify-path))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
;; Quick check for whether the path is already simple:
|
;; Quick check for whether the path is already simple:
|
||||||
|
|
Loading…
Reference in New Issue
Block a user