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

repair cm handling of extensions

Browse Source 
svn: r10045
This commit is contained in:
Matthew Flatt 2008-05-30 16:08:28 +00:00
parent 20a9a3e0b3
commit cbb7db6a2c
1 changed files with 39 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
collects/mzlib/cm.ss
View File

@ -141,42 +141,46 @@
(cons (path->bytes p) (cons (path->bytes p)
external-deps))))) external-deps)))))
d)))]) d)))])
(get-module-code path mode #:source-reader read-src-syntax))] (get-module-code path mode
compile
(lambda (a b) #f) ; extension handler
#:source-reader read-src-syntax))]
[code-dir (get-code-dir mode path)]) [code-dir (get-code-dir mode path)])
(when (not (directory-exists? code-dir)) (when code
(make-directory* code-dir)) (when (not (directory-exists? code-dir))
(with-compile-output (make-directory* code-dir))
zo-name (with-compile-output
(lambda (out) zo-name
(with-handlers ((exn:fail? (lambda (out)
(lambda (ex) (with-handlers ((exn:fail?
(close-output-port out) (lambda (ex)
(compilation-failure mode path zo-name #f (exn-message ex)) (close-output-port out)
(raise ex)))) (compilation-failure mode path zo-name #f (exn-message ex))
(parameterize ([current-write-relative-directory (raise ex))))
(let-values ([(base name dir?) (split-path path)]) (parameterize ([current-write-relative-directory
(if (eq? base 'relative) (let-values ([(base name dir?) (split-path path)])
(current-directory) (if (eq? base 'relative)
(path->complete-path base (current-directory))))]) (current-directory)
(write code out))) (path->complete-path base (current-directory))))])
;; redundant, but close as early as possible: (write code out)))
(close-output-port out) ;; redundant, but close as early as possible:
;; Note that we check time and write .deps before returning from with-compile-output... (close-output-port out)
(let ([ss-sec (file-or-directory-modify-seconds path)] ;; Note that we check time and write .deps before returning from with-compile-output...
[zo-sec (if (file-exists? zo-name) (let ([ss-sec (file-or-directory-modify-seconds path)]
(file-or-directory-modify-seconds zo-name) [zo-sec (if (file-exists? zo-name)
+inf.0)]) (file-or-directory-modify-seconds zo-name)
(when (< zo-sec ss-sec) +inf.0)])
(error 'compile-zo (when (< zo-sec ss-sec)
"date for newly created .zo file (~a @ ~a) is before source-file date (~a @ ~a)~a" (error 'compile-zo
zo-name "date for newly created .zo file (~a @ ~a) is before source-file date (~a @ ~a)~a"
(format-date (seconds->date zo-sec)) zo-name
path (format-date (seconds->date zo-sec))
(format-date (seconds->date ss-sec)) path
(if (> ss-sec (current-seconds)) (format-date (seconds->date ss-sec))
", which appears to be in the future" (if (> ss-sec (current-seconds))
"")))) ", which appears to be in the future"
(write-deps code mode path external-deps)))))]))) ""))))
(write-deps code mode path external-deps))))))])))
(trace-printf "end compile: ~a" path)) (trace-printf "end compile: ~a" path))
(define (format-date date) (define (format-date date)