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

Fix PR14175

Browse Source
This commit is contained in:
Jay McCarthy 2013-11-19 13:22:41 -07:00
parent 49cd879bf8
commit 80ba30eaab
1 changed files with 16 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
pkgs/compiler-pkgs/compiler-lib/compiler/commands/test.rkt
View File

@ -129,6 +129,7 @@
(module paths racket/base (module paths racket/base
(require setup/link (require setup/link
racket/match
racket/list) racket/list)
(struct col (name path) #:transparent) (struct col (name path) #:transparent)
@ -138,10 +139,14 @@
(and version? (and version?
(regexp-quote (version)))) (regexp-quote (version))))
(append (append
(for/list ([c+p (in-list (links #:user? user? #:version-regexp version-re #:with-path? #t))]) (for/list ([c+p
(in-list
(links #:user? user? #:version-regexp version-re #:with-path? #t))])
(col (car c+p) (col (car c+p)
(cdr c+p))) (cdr c+p)))
(for/list ([cp (in-list (links #:root? #t #:user? user? #:version-regexp version-re))] (for/list ([cp
(in-list
(links #:root? #t #:user? user? #:version-regexp version-re))]
#:when (directory-exists? cp) #:when (directory-exists? cp)
[collection (directory-list cp)] [collection (directory-list cp)]
#:when (directory-exists? (build-path cp collection))) #:when (directory-exists? (build-path cp collection)))
@ -166,9 +171,15 @@
;; This should be in Racket somewhere and return all the collection ;; This should be in Racket somewhere and return all the collection
;; paths, rather than just the first as collection-path does. ;; paths, rather than just the first as collection-path does.
(define (collection-paths c) (define (collection-paths c)
(match-define (list-rest sc more) (map path->string (explode-path c)))
(append*
(for/list ([col (all-collections)] (for/list ([col (all-collections)]
#:when (string=? c (col-name col))) #:when (string=? sc (col-name col)))
(col-path col))) (define p (col-path col))
(define cp (apply build-path p more))
(if (directory-exists? cp)
(list cp)
empty))))
(provide collection-paths)) (provide collection-paths))