Working with links in collection testing
This commit is contained in:
parent
99c60d725c
commit
3312a8064d
|
@ -32,21 +32,52 @@
|
||||||
[(not (file-exists? p))
|
[(not (file-exists? p))
|
||||||
(error 'test "Given path ~e does not exist" p)])]))
|
(error 'test "Given path ~e does not exist" p)])]))
|
||||||
|
|
||||||
;; XXX This should be in Racket somewhere and return all the paths,
|
(module paths racket/base
|
||||||
;; including the ones from the user and system collection links files (the system one is not specified in the docs, so I can't actually implement it correctly)
|
(require setup/link
|
||||||
(define (all-library-collection-paths)
|
racket/list)
|
||||||
(find-library-collection-paths))
|
|
||||||
|
|
||||||
;; XXX This should be in Racket somewhere and return all the
|
(struct col (name path) #:transparent)
|
||||||
;; collection paths, rather than just the first as collection-path
|
|
||||||
;; does.
|
(define (get-linked user? version?)
|
||||||
;;
|
(define version-re
|
||||||
;; This implementation is wrong, btw, because it would ignore
|
(and version?
|
||||||
;; collect-only links
|
(regexp-quote (version))))
|
||||||
|
(append
|
||||||
|
(for/list ([c+p (in-list (links #:user? user? #:version-regexp version-re #:with-path? #t))])
|
||||||
|
(col (car c+p)
|
||||||
|
(cdr c+p)))
|
||||||
|
(for/list ([cp (in-list (links #:root? #t #:user? user? #:version-regexp version-re))]
|
||||||
|
#:when (directory-exists? cp)
|
||||||
|
[collection (directory-list cp)]
|
||||||
|
#:when (directory-exists? (build-path cp collection)))
|
||||||
|
(col (path->string collection)
|
||||||
|
(build-path cp collection)))))
|
||||||
|
|
||||||
|
;; A list of `col's, where each collection may be represented
|
||||||
|
;; by multiple elements of the list, each with its own path.
|
||||||
|
(define (all-collections)
|
||||||
|
(remove-duplicates
|
||||||
|
(append*
|
||||||
|
(for/list ([cp (current-library-collection-paths)]
|
||||||
|
#:when (directory-exists? cp)
|
||||||
|
[collection (directory-list cp)]
|
||||||
|
#:when (directory-exists? (build-path cp collection)))
|
||||||
|
(col (path->string collection)
|
||||||
|
(build-path cp collection)))
|
||||||
|
(for*/list ([user? (in-list '(#t #f))]
|
||||||
|
[version? (in-list '(#t #f))])
|
||||||
|
(get-linked user? version?)))))
|
||||||
|
|
||||||
|
;; This should be in Racket somewhere and return all the collection
|
||||||
|
;; paths, rather than just the first as collection-path does.
|
||||||
(define (collection-paths c)
|
(define (collection-paths c)
|
||||||
(for/list ([r (all-library-collection-paths)]
|
(for/list ([col (all-collections)]
|
||||||
#:when (directory-exists? (build-path r c)))
|
#:when (string=? c (col-name col)))
|
||||||
(build-path r c)))
|
(col-path col)))
|
||||||
|
|
||||||
|
(provide collection-paths))
|
||||||
|
|
||||||
|
(require (submod "." paths))
|
||||||
|
|
||||||
(define collections? #f)
|
(define collections? #f)
|
||||||
(define packages? #f)
|
(define packages? #f)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user