From 893dfe5d352f734b10db5ca8a896f53876b02029 Mon Sep 17 00:00:00 2001 From: dyb Date: Tue, 7 Nov 2017 21:49:08 -0500 Subject: [PATCH] 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 original commit: c2cb8c79a925c0eb2f9d589e3a497712800bd1dc --- LOG | 8 ++++++++ mats/7.ms | 41 +++++++++++++++++++++++++++++++++++++++++ s/syntax.ss | 35 ++++++++++++++++++++++++----------- 3 files changed, 73 insertions(+), 11 deletions(-) diff --git a/LOG b/LOG index 482d5ebbc0..2b92305b49 100644 --- a/LOG +++ b/LOG @@ -744,3 +744,11 @@ mats/examples.ms, examples/ez-grammar.ss, examples/ez-grammar-test.ss, 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 diff --git a/mats/7.ms b/mats/7.ms index aa5b9eddb0..29bba8229c 100644 --- a/mats/7.ms +++ b/mats/7.ms @@ -834,6 +834,47 @@ (begin (rm-rf "testdir") #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 diff --git a/s/syntax.ss b/s/syntax.ss index 7c1c18568f..bbec064e3a 100644 --- a/s/syntax.ss +++ b/s/syntax.ss @@ -4787,7 +4787,14 @@ found-uid)] [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))]) - ($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 [(search-loaded-libraries path) => (lambda (found-uid) @@ -5193,16 +5200,22 @@ (let ([ofn-mod-time (file-modification-time ofn)]) (if (time>=? ofn-mod-time (with-new-who who (lambda () (file-modification-time ifn)))) (with-message "object file is not older" - (let ([rcinfo* (load-recompile-info who ofn)]) - (if (andmap - (lambda (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*) + (let ([rcinfo* (guard (c [else (with-message (with-output-to-string + (lambda () + (display-string "failed to process object file: ") + (display-condition c))) + #f)]) + (load-recompile-info who ofn))]) + (if (and rcinfo* + (andmap + (lambda (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) (guard (c [(and ($recompile-condition? c) (eq? ($recompile-importer-path c) #f)) (with-message (format "recompiling ~s because a dependency has changed" ifn)