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

adjust ".plt" S-expression matching to accept more old archives

Browse Source
This commit is contained in:
Matthew Flatt 2013-07-22 16:34:21 -06:00
parent 682916c8fe
commit f85221afca
1 changed files with 6 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
racket/collects/setup/unpack.rkt
View File

@ -286,8 +286,9 @@
[(conflicts) ',conflicts] [(conflicts) ',conflicts]
[(plt-relative?) ,plt-relative?] [(plt-relative?) ,plt-relative?]
[(plt-home-relative?) ,plt-home-relative?] [(plt-home-relative?) ,plt-home-relative?]
[(test-plt-dirs) ,test-dirs] ; #f or `(quote ,dirs) . ,(or `([(test-plt-dirs) ,test-dirs] ; #f or `(quote ,dirs)
[else (failure)])) [else (failure)])
`([,(and 'else test-dirs) (failure)]))))
(lambda (request failure) (lambda (request failure)
(case request (case request
[(name) name] [(name) name]
@ -297,6 +298,7 @@
[(plt-relative?) plt-relative?] [(plt-relative?) plt-relative?]
[(plt-home-relative?) plt-home-relative?] [(plt-home-relative?) plt-home-relative?]
[(test-plt-dirs) (and test-dirs [(test-plt-dirs) (and test-dirs
(not (eq? test-dirs 'else))
(cadr test-dirs))] (cadr test-dirs))]
[else (failure)]))] [else (failure)]))]
[else [else
@ -444,7 +446,8 @@
(print-status (format "Unpacking ~a from ~a" name archive)) (print-status (format "Unpacking ~a from ~a" name archive))
(let ([u (read p)]) (let ([u (read p)])
(match u (match u
[`(unit (import main-collects-parent-dir mzuntar) (export) [`(unit (import ,(? symbol?) mzuntar)
(export)
(mzuntar void) (mzuntar void)
(quote ,collections)) (quote ,collections))
(make-directory* (car target-dir-info)) (make-directory* (car target-dir-info))