Fix lots of prop paths.

This commit is contained in:
Eli Barzilay 2012-06-14 22:11:55 -04:00
parent 7d40901381
commit 749259d8e1

View File

@ -441,21 +441,29 @@ path/s is either such a string or a list of them.
(write-props))
(define (verify)
(define root (find-root))
(printf "Root: ~a\n" root)
(printf "Root: ~a..." root)
(flush-output)
(parameterize ([current-directory root])
(let loop ([tree props-tree] [path '(" ")])
(define errors 0)
(let loop ([tree props-tree] [path '()])
(for ([sub (in-list (Tree-subs tree))])
(define name (symbol->string (Tree-name sub)))
(define (print-path more)
(for ([x (in-list (reverse path))]) (printf "~a/" x))
(printf "~a: ~a\n" name more))
(define (path-error more)
(when (= 0 errors) (newline) (flush-output))
(set! errors (add1 errors))
(eprintf " ")
(for ([x (in-list (reverse path))]) (eprintf "~a/" x))
(eprintf "~a: ~a\n" name more))
(cond [(equal? "" name)
(print-path "empty name")]
(path-error "empty name")]
[(directory-exists? name)
(parameterize ([current-directory name])
(loop sub (cons name path)))]
[(not (file-exists? name))
(print-path "Missing file/directory")])))))
(path-error "Missing file/directory")])))
(if (errors . > . 0)
(error* 'verify "~s path errors" errors)
(printf " no errors.\n"))))
(set! running-as-script? #t)
;; (perhaps add some `--force' flag to (set! check-existing-paths? #f))
(define verb (if (pair? args) (car args) (usage "missing subcommand")))
@ -2162,7 +2170,6 @@ path/s is either such a string or a list of them.
"doc/release-notes/stepper" responsible (clements)
"doc/release-notes/teachpack" responsible (matthias)
"man/man1/drracket.1" responsible (robby)
"man/man1/drscheme.1" responsible (robby)
"man/man1/gracket.1" responsible (mflatt)
"man/man1/mred.1" responsible (mflatt)
"man/man1/mzscheme.1" responsible (mflatt)