suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

make-path->relative-string: handle immediate directory path

Browse Source
This commit is contained in:
Matthew Flatt 2014-11-24 16:23:06 -07:00
parent d0b94f48e0
commit 6096d567af
2 changed files with 16 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
pkgs/racket-pkgs/racket-test/tests/setup/path-to-relative.rkt Normal file
View File

@ -0,0 +1,12 @@
#lang racket/base
(require setup/path-to-relative
rackunit
setup/dirs
racket/path)
(check-equal? "<collects>/"
(path->relative-string/library (find-collects-dir)))
(check-equal? "<collects>/racket"
(path->relative-string/library (path-only (collection-file-path "base.rkt" "racket"))))
(check-equal? "<collects>/racket/base.rkt"
(path->relative-string/library (collection-file-path "base.rkt" "racket")))

5
racket/collects/setup/path-to-relative.rkt
View File

@ -42,7 +42,10 @@
(let* ([r (cdr exploded)] (let* ([r (cdr exploded)]
;; note: use "/"s, to get paths as in `require's ;; note: use "/"s, to get paths as in `require's
[r (map (lambda (p) (list #"/" p)) r)] [r (map (lambda (p) (list #"/" p)) r)]
[r (apply bytes-append (cdr (apply append r)))]) [r (apply bytes-append (let ([l (apply append r)])
(if (pair? l)
(cdr l)
null)))])
(string-append prefix (bytes->string/locale r)))))) (string-append prefix (bytes->string/locale r))))))
(if (procedure? default) (default path) default))) (if (procedure? default) (default path) default)))
path->relative-string) path->relative-string)