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

mes: iota: Make compatible with Guile.

Browse source 
* mes/module/mes/scm.mes (iota): Throw exception when n < 0.
* tests/scm.test: Import (mes catch).
("iota -1"): Rewrite with exception handling.
This commit is contained in:
Ekaitz Zarraga 2023-08-24 19:06:40 +02:00 committed by Janneke Nieuwenhuizen
parent ff02777236
commit 294d8a9737
2 changed files with 14 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
mes/module/mes/scm.mes
View file

@ -2,6 +2,7 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2023 Ekaitz Zarraga <ekaitz@elenq.tech>
;;;
;;; This file is part of GNU Mes.
;;;
@ -164,8 +165,10 @@
(list-tail (cdr x) (- n 1))))
(define (iota n)
(if (<= n 0) '()
(append2 (iota (- n 1)) (list (- n 1)))))
(cond
((< n 0) (throw 'wrong-type-arg n))
((= n 0) '())
(else (append2 (iota (- n 1)) (list (- n 1))))))
(define (reverse lst)
(let loop ((lst lst) (r '()))

10
tests/scm.test
View file

@ -10,6 +10,7 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2023 Ekaitz Zarraga <ekaitz@elenq.tech>
;;;
;;; This file is part of GNU Mes.
;;;
@ -30,6 +31,8 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (mes catch))
(cond-expand
(mes
(primitive-load "module/mes/test.scm"))
@ -131,7 +134,12 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
'() (iota 0))
(pass-if-equal "iota -1"
'() (iota -1))
'iota-negative-length
(catch 'wrong-type-arg
(lambda ()
(iota -1))
(lambda (key . args)
'iota-negative-length)))
(pass-if "cond-expand" (sequal? (cond-expand (foobar #f) (mes (display ": pass: *YAY*") 'mes) (guile (display ": pass: *GUILE*") 'mes)) 'mes))