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

show the two problematic collection names

Browse Source 
svn: r15596
This commit is contained in:
Eli Barzilay 2009-07-28 12:46:12 +00:00
parent 9c7584b8c8
commit 50ea3d91fe
1 changed files with 8 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/setup/setup-unit.ss
View File

@ -331,6 +331,12 @@
(define all-names (map cc->name all-ccs)) (define all-names (map cc->name all-ccs))
(define given-names (map cc->name given-ccs)) (define given-names (map cc->name given-ccs))
(define (cc-mark cc) (build-path (cc-path cc) ".setup-plt-marker")) (define (cc-mark cc) (build-path (cc-path cc) ".setup-plt-marker"))
(define (complain-about-mark name mark)
(let ([given (with-handlers ([void (lambda (_) '???)])
(with-input-from-file mark read-line))])
(error 'setup-plt
"given collection path: \"~a\" refers to the same directory as another given collection path, \"~a\""
name given)))
;; For cleanup: try to remove all files, be silent ;; For cleanup: try to remove all files, be silent
(define (cleanup) (define (cleanup)
(for ([cc (append given-ccs all-ccs)]) (for ([cc (append given-ccs all-ccs)])
@ -351,19 +357,14 @@
(for ([cc given-ccs] [name given-names]) (for ([cc given-ccs] [name given-names])
(let ([mark (cc-mark cc)]) (let ([mark (cc-mark cc)])
(if (file-exists? mark) (if (file-exists? mark)
(error 'setup-plt (complain-about-mark name mark)
"given collection path: ~e refers to the same directory as another given collection path"
name)
(with-output-to-file mark (lambda () (printf "~a\n" name))))))) (with-output-to-file mark (lambda () (printf "~a\n" name)))))))
;; Finally scan all ccs and look for duplicates ;; Finally scan all ccs and look for duplicates
(define (scan-all) (define (scan-all)
(for ([cc all-ccs] [name all-names]) (for ([cc all-ccs] [name all-names])
(when (and (not (member name given-names)) (when (and (not (member name given-names))
(file-exists? (cc-mark cc))) (file-exists? (cc-mark cc)))
(let ([given (with-input-from-file (cc-mark cc) read-line)]) (complain-about-mark name (cc-mark cc)))))
(error 'setup-plt
"given collection path: ~e refers to the same directory as another given collection path"
name)))))
(dynamic-wind (dynamic-wind
void void
(lambda () (remove-markers) (put-markers) (scan-all) given-ccs) (lambda () (remove-markers) (put-markers) (scan-all) given-ccs)