fail when the C compiler fails, and clean up when we do
compile-to-file returned process-wait's values and main dropped them, so cc errors were printed, but then main compiler exited 0. Also cleanup tmp C files when compilation failed.
This commit is contained in:
8
Makefile
8
Makefile
@@ -67,8 +67,12 @@ SEX_TEST_PROGRAMS = hello-world lists comments unicode serialize
|
|||||||
check-modules: sexc
|
check-modules: sexc
|
||||||
@$(MAKE) --no-print-directory -C ./tests/modules check SEXC=../../sexc
|
@$(MAKE) --no-print-directory -C ./tests/modules check SEXC=../../sexc
|
||||||
|
|
||||||
|
# The failure paths are checked end to end; see tests/exit-code/Makefile.
|
||||||
|
check-exit-code: sexc
|
||||||
|
@$(MAKE) --no-print-directory -C ./tests/exit-code check SEXC=../../sexc
|
||||||
|
|
||||||
run-tests: sexc sex-tests sextest
|
run-tests: sexc sex-tests sextest
|
||||||
./sex-tests && ./sextest --sexc=./sexc $(SEX_TEST_PROGRAMS:%=./tests/sex-programs/%.sex) && $(MAKE) check-modules
|
./sex-tests && ./sextest --sexc=./sexc $(SEX_TEST_PROGRAMS:%=./tests/sex-programs/%.sex) && $(MAKE) check-modules && $(MAKE) check-exit-code
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
rm -f $(OBJ) main.o
|
rm -f $(OBJ) main.o
|
||||||
@@ -77,4 +81,4 @@ clean:
|
|||||||
rm -f sexc sex-tests sextest
|
rm -f sexc sex-tests sextest
|
||||||
$(MAKE) -C ./tests/modules clean
|
$(MAKE) -C ./tests/modules clean
|
||||||
|
|
||||||
.PHONY: clean run-tests sex-tests sextest check-modules
|
.PHONY: clean run-tests sex-tests sextest check-modules check-exit-code
|
||||||
|
|||||||
26
sexc.scm
26
sexc.scm
@@ -2,6 +2,7 @@
|
|||||||
(scheme base) ; call/cc
|
(scheme base) ; call/cc
|
||||||
brev-separate
|
brev-separate
|
||||||
(chicken base)
|
(chicken base)
|
||||||
|
(chicken condition) ; handle-exceptions
|
||||||
(chicken file)
|
(chicken file)
|
||||||
(chicken plist)
|
(chicken plist)
|
||||||
(chicken pretty-print)
|
(chicken pretty-print)
|
||||||
@@ -117,15 +118,22 @@
|
|||||||
(emit-c sex-forms)))))
|
(emit-c sex-forms)))))
|
||||||
|
|
||||||
(define (compile-to-file sex-forms output args cc-args)
|
(define (compile-to-file sex-forms output args cc-args)
|
||||||
|
"Hand the generated C to the C compiler. Returns the compiler's exit
|
||||||
|
status, which is ours to pass on."
|
||||||
(let ((compiler (or (get-arg args 'c-compiler #f)
|
(let ((compiler (or (get-arg args 'c-compiler #f)
|
||||||
(get-env-var "SEX_CC")
|
(get-env-var "SEX_CC")
|
||||||
"cc"))
|
"cc"))
|
||||||
(out-file (if (eq? output 'default)
|
(out-file (if (eq? output 'default)
|
||||||
"a.out"
|
"a.out"
|
||||||
output)))
|
output))
|
||||||
;; The generated C goes to a temporary .c file rather than the
|
;; The generated C goes to a temporary .c file rather than the
|
||||||
;; compiler's stdin
|
;; compiler's stdin. It is removed however we leave -- emit-c
|
||||||
(let ((c-file (create-temporary-file "c")))
|
;; can throw, and used to leave the file behind when it did
|
||||||
|
(c-file (create-temporary-file "c")))
|
||||||
|
;; An unhandled error ends the process without unwinding, so the
|
||||||
|
;; cleanup cannot be left to dynamic-wind
|
||||||
|
(handle-exceptions exn
|
||||||
|
(begin (delete-file* c-file) (abort exn))
|
||||||
(with-output-to-file c-file
|
(with-output-to-file c-file
|
||||||
(lambda () (emit-c sex-forms)))
|
(lambda () (emit-c sex-forms)))
|
||||||
(let ((proc (process compiler (append (list "-o" out-file)
|
(let ((proc (process compiler (append (list "-o" out-file)
|
||||||
@@ -135,9 +143,9 @@
|
|||||||
(list c-file)
|
(list c-file)
|
||||||
cc-args))))
|
cc-args))))
|
||||||
(call-with-values (lambda () (process-wait proc))
|
(call-with-values (lambda () (process-wait proc))
|
||||||
(lambda status
|
(lambda (pid normal-exit? status)
|
||||||
(delete-file* c-file)
|
(delete-file* c-file)
|
||||||
(apply values status)))))))
|
(if normal-exit? status 1)))))))
|
||||||
|
|
||||||
(define (semantic-process-forms raw-forms input-source)
|
(define (semantic-process-forms raw-forms input-source)
|
||||||
(if (eq? input-source 'stdin)
|
(if (eq? input-source 'stdin)
|
||||||
@@ -198,5 +206,7 @@
|
|||||||
(get-arg args 'emit-c #f))
|
(get-arg args 'emit-c #f))
|
||||||
;; Emit processed and macro-expanded sex code, or emit C code
|
;; Emit processed and macro-expanded sex code, or emit C code
|
||||||
(emit-c-or-sex sex-forms output args)
|
(emit-c-or-sex sex-forms output args)
|
||||||
;; Compile file!
|
;; Compile file! The C compiler's status is ours too
|
||||||
(compile-to-file sex-forms output args cc-args)))))))
|
(let ((status (compile-to-file sex-forms output args cc-args)))
|
||||||
|
(unless (zero? status)
|
||||||
|
(exit status)))))))))
|
||||||
|
|||||||
26
tests/exit-code/Makefile
Normal file
26
tests/exit-code/Makefile
Normal file
@@ -0,0 +1,26 @@
|
|||||||
|
# The failure paths.
|
||||||
|
#
|
||||||
|
# Both need a process to show themselves, so neither fits the unit
|
||||||
|
# suite: sexc has to fail when cc fails -- exiting 0 after a failed
|
||||||
|
# compile makes every driver, sextest included, read it as success --
|
||||||
|
# and it has to clean up its temporary .c when its own emission throws.
|
||||||
|
#
|
||||||
|
# Everything is built inside a scratch TMPDIR, so nothing is left here
|
||||||
|
# to clean up.
|
||||||
|
|
||||||
|
SEXC ?= ../../sexc
|
||||||
|
|
||||||
|
check:
|
||||||
|
@d=`mktemp -d`; \
|
||||||
|
TMPDIR=$$d $(SEXC) nested-pointer.sex -o $$d/out >/dev/null 2>&1; \
|
||||||
|
if [ -n "`find $$d -name '*.c'`" ]; then \
|
||||||
|
echo "exit code FAILED: the temporary .c survived a failed emission"; \
|
||||||
|
rm -rf $$d; exit 1; \
|
||||||
|
fi; \
|
||||||
|
if $(SEXC) hello.sex -o $$d/out -- -no-such-cc-flag >/dev/null 2>&1; then \
|
||||||
|
echo "exit code FAILED: sexc reported success after cc failed"; \
|
||||||
|
rm -rf $$d; exit 1; \
|
||||||
|
fi; \
|
||||||
|
rm -rf $$d; echo "exit code ok"
|
||||||
|
|
||||||
|
.PHONY: check
|
||||||
4
tests/exit-code/hello.sex
Normal file
4
tests/exit-code/hello.sex
Normal file
@@ -0,0 +1,4 @@
|
|||||||
|
;;; Compiles cleanly, so the only way the build can fail is the bogus
|
||||||
|
;;; flag handed to cc -- which is the point.
|
||||||
|
(pub fn main () int
|
||||||
|
(return 0))
|
||||||
4
tests/exit-code/nested-pointer.sex
Normal file
4
tests/exit-code/nested-pointer.sex
Normal file
@@ -0,0 +1,4 @@
|
|||||||
|
;;; Rejected by the writer, so emit-c throws: there is a temporary .c
|
||||||
|
;;; by then, and it must not survive.
|
||||||
|
(fn f () void
|
||||||
|
(var p (* (* char))))
|
||||||
Reference in New Issue
Block a user