From 6096d567af4bab05fccfed636ec2326b16ca70fc Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 24 Nov 2014 16:23:06 -0700 Subject: [PATCH] make-path->relative-string: handle immediate directory path --- .../racket-test/tests/setup/path-to-relative.rkt | 12 ++++++++++++ racket/collects/setup/path-to-relative.rkt | 5 ++++- 2 files changed, 16 insertions(+), 1 deletion(-) create mode 100644 pkgs/racket-pkgs/racket-test/tests/setup/path-to-relative.rkt diff --git a/pkgs/racket-pkgs/racket-test/tests/setup/path-to-relative.rkt b/pkgs/racket-pkgs/racket-test/tests/setup/path-to-relative.rkt new file mode 100644 index 0000000000..453eb17fef --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/setup/path-to-relative.rkt @@ -0,0 +1,12 @@ +#lang racket/base +(require setup/path-to-relative + rackunit + setup/dirs + racket/path) + +(check-equal? "/" + (path->relative-string/library (find-collects-dir))) +(check-equal? "/racket" + (path->relative-string/library (path-only (collection-file-path "base.rkt" "racket")))) +(check-equal? "/racket/base.rkt" + (path->relative-string/library (collection-file-path "base.rkt" "racket"))) diff --git a/racket/collects/setup/path-to-relative.rkt b/racket/collects/setup/path-to-relative.rkt index 605653520b..5f6b7b5819 100644 --- a/racket/collects/setup/path-to-relative.rkt +++ b/racket/collects/setup/path-to-relative.rkt @@ -42,7 +42,10 @@ (let* ([r (cdr exploded)] ;; note: use "/"s, to get paths as in `require's [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)))))) (if (procedure? default) (default path) default))) path->relative-string)