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

mescc: Do not crash when attemting to link files without extension.

Browse source 
* module/mescc/mescc.scm (replace-suffix): Add ELSE clause to IF for
base; add IF for old-suffix.
This commit is contained in:
Jan (janneke) Nieuwenhuizen 2020-08-23 09:52:01 +02:00
parent ae14a08aad
commit ddfdd1cb7f
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
1 changed files with 4 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
module/mescc/mescc.scm
View file

@ -1,5 +1,5 @@
;;; GNU Mes --- Maxwell Equations of Software ;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of GNU Mes. ;;; This file is part of GNU Mes.
;;; ;;;
@ -242,7 +242,7 @@
,@(append-map (cut list "-f" <>) M1-files) ,@(append-map (cut list "-f" <>) M1-files)
"-o" ,M1-blood-elf-footer))) "-o" ,M1-blood-elf-footer)))
(when (and verbose? (> verbose? 1)) (when (and verbose? (> verbose? 1))
(format (current-error-port) "~a\n" (string-join command))) (format (current-error-port) "~a\n" (string-join command)))
(and (zero? (apply assert-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)))
@ -250,8 +250,8 @@
(define (replace-suffix file-name suffix) (define (replace-suffix file-name suffix)
(let* ((parts (string-split file-name #\.)) (let* ((parts (string-split file-name #\.))
(base (if (pair? (cdr parts)) (drop-right parts 1))) (base (if (pair? (cdr parts)) (drop-right parts 1) (list file-name)))
(old-suffix (last parts)) (old-suffix (if (pair? (cdr parts)) (last parts) ""))
(program-prefix (cond ((string-prefix? "arm-mes-" old-suffix) ".arm-mes-") (program-prefix (cond ((string-prefix? "arm-mes-" old-suffix) ".arm-mes-")
((string-prefix? "x86-mes-" old-suffix) ".x86-mes-") ((string-prefix? "x86-mes-" old-suffix) ".x86-mes-")
((string-prefix? "x86_64-mes-" old-suffix) ".x86_64-mes-") ((string-prefix? "x86_64-mes-" old-suffix) ".x86_64-mes-")