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

maybe-compile-{file,program,library} and automatic import

Browse Source 
compilation now treat a malformed object file as if it were
not present and needs to be regenerated.  A malformed object
file (particularly a truncated one) might occur if the compiling
processes is killed or aborts before it has a chance to delete
a partial object file.
  syntax.ss,
  7.ms

original commit: c2cb8c79a925c0eb2f9d589e3a497712800bd1dc
This commit is contained in:
dyb 2017-11-07 21:49:08 -05:00
parent 431c1af87f
commit 893dfe5d35
3 changed files with 73 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
LOG
View File

@ -744,3 +744,11 @@
mats/examples.ms, mats/examples.ms,
examples/ez-grammar.ss, examples/ez-grammar-test.ss, examples/ez-grammar.ss, examples/ez-grammar-test.ss,
examples/Makefile examples/Makefile
- maybe-compile-{file,program,library} and automatic import
compilation now treat a malformed object file as if it were
not present and needs to be regenerated. A malformed object
file (particularly a truncated one) might occur if the compiling
processes is killed or aborts before it has a chance to delete
a partial object file.
syntax.ss,
7.ms

41
mats/7.ms
View File

@ -834,6 +834,47 @@
(begin (begin
(rm-rf "testdir") (rm-rf "testdir")
#t) #t)
; make sure maybe-compile-file handles incomplete fasl files
(begin
(mkfile "testfile-mc-2a.ss"
'(library (testfile-mc-2a)
(export q)
(import (chezscheme))
(define f
(lambda ()
(printf "running f\n")
"x"))
(define-syntax q
(begin
(printf "expanding testfile-mc-2a\n")
(lambda (x)
(printf "expanding q\n")
#'(f))))))
(mkfile "testfile-mc-2.ss"
'(import (chezscheme) (testfile-mc-2a))
'(define-syntax qq
(begin
(printf "expanding testfile-mc-2\n")
(lambda (x)
(printf "expanding qq\n")
#'q)))
'(printf "qq => ~a\n" qq))
(delete-file "testfile-mc-2a.so")
(delete-file "testfile-mc-2.so")
(display-string (separate-compile '(lambda (x) (parameterize ([compile-file-message #f] [compile-imported-libraries #t] [compile-compressed #f]) (maybe-compile-program x))) 'mc-2))
#t)
(begin
(let ([p (open-file-input/output-port "testfile-mc-2a.so" (file-options no-create no-fail no-truncate))])
(set-port-length! p 73)
(close-port p))
(display-string (separate-compile '(lambda (x) (parameterize ([compile-file-message #f] [compile-imported-libraries #t] [compile-compressed #f] [import-notify #t]) (maybe-compile-program x))) 'mc-2))
#t)
(begin
(let ([p (open-file-input/output-port "testfile-mc-2.so" (file-options no-create no-fail no-truncate))])
(set-port-length! p 87)
(close-port p))
(display-string (separate-compile '(lambda (x) (parameterize ([compile-file-message #f] [compile-imported-libraries #t] [compile-compressed #f] [import-notify #t]) (maybe-compile-program x))) 'mc-2))
#t)
) )
(mat make-boot-file (mat make-boot-file

35
s/syntax.ss
View File

@ -4787,7 +4787,14 @@
found-uid)] found-uid)]
[else ($oops #f "re~:[loading~;compiling~] ~a did not define library ~s" compile-file? src-path path)])]) [else ($oops #f "re~:[loading~;compiling~] ~a did not define library ~s" compile-file? src-path path)])])
(parameterize ([source-directories (cons (path-parent src-path) (source-directories))]) (parameterize ([source-directories (cons (path-parent src-path) (source-directories))])
($load-library obj-path (if ct? 'load 'revisit))) (guard (c [(and (irritants-condition? c) (member obj-path (condition-irritants c)))
(with-message (with-output-to-string
(lambda ()
(display-string "failed to load object file: ")
(display-condition c)))
($oops/c #f ($make-recompile-condition path)
"problem loading object file ~a ~s" obj-path c))])
($load-library obj-path (if ct? 'load 'revisit))))
(cond (cond
[(search-loaded-libraries path) => [(search-loaded-libraries path) =>
(lambda (found-uid) (lambda (found-uid)
@ -5193,16 +5200,22 @@
(let ([ofn-mod-time (file-modification-time ofn)]) (let ([ofn-mod-time (file-modification-time ofn)])
(if (time>=? ofn-mod-time (with-new-who who (lambda () (file-modification-time ifn)))) (if (time>=? ofn-mod-time (with-new-who who (lambda () (file-modification-time ifn))))
(with-message "object file is not older" (with-message "object file is not older"
(let ([rcinfo* (load-recompile-info who ofn)]) (let ([rcinfo* (guard (c [else (with-message (with-output-to-string
(if (andmap (lambda ()
(lambda (rcinfo) (display-string "failed to process object file: ")
(andmap (display-condition c)))
(lambda (x) #f)])
(with-source-path who x (load-recompile-info who ofn))])
(lambda (x) (if (and rcinfo*
(time<=? (with-new-who who (lambda () (file-modification-time x))) ofn-mod-time)))) (andmap
(recompile-info-include-req* rcinfo))) (lambda (rcinfo)
rcinfo*) (andmap
(lambda (x)
(with-source-path who x
(lambda (x)
(time<=? (with-new-who who (lambda () (file-modification-time x))) ofn-mod-time))))
(recompile-info-include-req* rcinfo)))
rcinfo*))
(if (compile-imported-libraries) (if (compile-imported-libraries)
(guard (c [(and ($recompile-condition? c) (eq? ($recompile-importer-path c) #f)) (guard (c [(and ($recompile-condition? c) (eq? ($recompile-importer-path c) #f))
(with-message (format "recompiling ~s because a dependency has changed" ifn) (with-message (format "recompiling ~s because a dependency has changed" ifn)