artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mescc: Be sure to exit upon system* failure.

Browse source 
* module/mescc/mescc.scm (assert-system*): New function.
  (M1->hex2, hex2->elf, M1->blood-elf): Use it.
This commit is contained in:
Jan Nieuwenhuizen 2018-07-09 09:25:38 +02:00
parent b4fa5609fe
commit a25653e7f1
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
1 changed files with 9 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
module/mescc/mescc.scm
View file

@ -160,7 +160,7 @@
"-o" ,hex2-file-name))) "-o" ,hex2-file-name)))
(when verbose? (when verbose?
(stderr "~a\n" (string-join command))) (stderr "~a\n" (string-join command)))
(and (zero? (apply system* command)) (and (zero? (apply assert-system* command))
hex2-file-name))) hex2-file-name)))
(define* (hex2->elf options hex2-files #:key elf-footer) (define* (hex2->elf options hex2-files #:key elf-footer)
@ -182,7 +182,7 @@
"-o" ,elf-file-name))) "-o" ,elf-file-name)))
(when verbose? (when verbose?
(stderr "~a\n" (string-join command))) (stderr "~a\n" (string-join command)))
(and (zero? (apply system* command)) (and (zero? (apply assert-system* command))
elf-file-name))) elf-file-name)))
(define (M1->blood-elf options M1-files) (define (M1->blood-elf options M1-files)
@ -198,7 +198,7 @@
"-o" ,M1-blood-elf-footer))) "-o" ,M1-blood-elf-footer)))
(when verbose? (when verbose?
(format (current-error-port) "~a\n" (string-join command))) (format (current-error-port) "~a\n" (string-join command)))
(and (zero? (apply system* command)) (and (zero? (apply assert-system* command))
(let* ((options (acons 'compile #t options)) ; ugh (let* ((options (acons 'compile #t options)) ; ugh
(options (acons 'output blood-elf-footer options))) (options (acons 'output blood-elf-footer options)))
(M1->hex2 options (list M1-blood-elf-footer)))))) (M1->hex2 options (list M1-blood-elf-footer))))))
@ -228,6 +228,12 @@
(if (string-null? prefix) o (string-append prefix "/" o))) (if (string-null? prefix) o (string-append prefix "/" o)))
(prefix-file file-name))) (prefix-file file-name)))
(define (assert-system* . commands)
(let ((status (apply system* commands)))
(when (not (zero? status))
(stderr "mescc: failed: ~a\n" (string-join command))
(exit status))
status))
(define (multi-opt option-name) (lambda (o) (and (eq? (car o) option-name) (cdr o)))) (define (multi-opt option-name) (lambda (o) (and (eq? (car o) option-name) (cdr o))))