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

repair cm handling of extensions

Browse Source 
svn: r10045

original commit: cbb7db6a2c8bb715b831d7a00910fc1aad730459
This commit is contained in:
Matthew Flatt 2008-05-30 16:08:28 +00:00
parent 0d57734b19
commit 9f2bf9963f
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)
external-deps)))))
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)])
(when (not (directory-exists? code-dir))
(make-directory* code-dir))
(with-compile-output
zo-name
(lambda (out)
(with-handlers ((exn:fail?
(lambda (ex)
(close-output-port out)
(compilation-failure mode path zo-name #f (exn-message ex))
(raise ex))))
(parameterize ([current-write-relative-directory
(let-values ([(base name dir?) (split-path path)])
(if (eq? base 'relative)
(current-directory)
(path->complete-path base (current-directory))))])
(write code out)))
;; redundant, but close as early as possible:
(close-output-port out)
;; Note that we check time and write .deps before returning from with-compile-output...
(let ([ss-sec (file-or-directory-modify-seconds path)]
[zo-sec (if (file-exists? zo-name)
(file-or-directory-modify-seconds zo-name)
+inf.0)])
(when (< zo-sec ss-sec)
(error 'compile-zo
"date for newly created .zo file (~a @ ~a) is before source-file date (~a @ ~a)~a"
zo-name
(format-date (seconds->date zo-sec))
path
(format-date (seconds->date ss-sec))
(if (> ss-sec (current-seconds))
", which appears to be in the future"
""))))
(write-deps code mode path external-deps)))))])))
(when code
(when (not (directory-exists? code-dir))
(make-directory* code-dir))
(with-compile-output
zo-name
(lambda (out)
(with-handlers ((exn:fail?
(lambda (ex)
(close-output-port out)
(compilation-failure mode path zo-name #f (exn-message ex))
(raise ex))))
(parameterize ([current-write-relative-directory
(let-values ([(base name dir?) (split-path path)])
(if (eq? base 'relative)
(current-directory)
(path->complete-path base (current-directory))))])
(write code out)))
;; redundant, but close as early as possible:
(close-output-port out)
;; Note that we check time and write .deps before returning from with-compile-output...
(let ([ss-sec (file-or-directory-modify-seconds path)]
[zo-sec (if (file-exists? zo-name)
(file-or-directory-modify-seconds zo-name)
+inf.0)])
(when (< zo-sec ss-sec)
(error 'compile-zo
"date for newly created .zo file (~a @ ~a) is before source-file date (~a @ ~a)~a"
zo-name
(format-date (seconds->date zo-sec))
path
(format-date (seconds->date ss-sec))
(if (> ss-sec (current-seconds))
", which appears to be in the future"
""))))
(write-deps code mode path external-deps))))))])))
(trace-printf "end compile: ~a" path))
(define (format-date date)