scm+test: Factor-out math and vector.

* module/mes/base-0.mes (quotient): Remove.
* module/mes/scm.mes (quotient): Add.
* tests/scm.test: Remove arithmetic/math tests.
* tests/math.test: New file.
* GNUmakefile (TESTS): Add it
This commit is contained in:
Jan Nieuwenhuizen 2017-04-02 11:34:40 +02:00
parent dbd987ab19
commit 9896f9eb92
5 changed files with 85 additions and 52 deletions

View file

@ -57,10 +57,11 @@ TESTS:=\
tests/closure.test\ tests/closure.test\
tests/quasiquote.test\ tests/quasiquote.test\
tests/let.test\ tests/let.test\
tests/vector.test\
tests/scm.test\ tests/scm.test\
tests/display.test\ tests/display.test\
tests/cwv.test\ tests/cwv.test\
tests/math.test\
tests/vector.test\
tests/srfi-1.test\ tests/srfi-1.test\
tests/srfi-13.test\ tests/srfi-13.test\
tests/srfi-14.test\ tests/srfi-14.test\

View file

@ -35,8 +35,6 @@
(define (primitive-eval e) (core:eval e (current-module))) (define (primitive-eval e) (core:eval e (current-module)))
(define eval core:eval) (define eval core:eval)
(define quotient /)
(define-macro (defined? x) (define-macro (defined? x)
(list 'assq x '(cddr (current-module)))) (list 'assq x '(cddr (current-module))))

View file

@ -282,6 +282,8 @@
;;; Math ;;; Math
(define quotient /)
(define (<= . rest) (define (<= . rest)
(or (apply < rest) (or (apply < rest)
(apply = rest))) (apply = rest)))

81
tests/math.test Executable file
View file

@ -0,0 +1,81 @@
#! /bin/sh
# -*-scheme-*-
echo ' ()' | cat $(dirname $0)/../module/mes/base-0.mes $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@"
#paredit:||
exit $?
!#
;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(mes-use-module (mes scm))
(mes-use-module (srfi srfi-0))
(mes-use-module (mes test))
(pass-if "+" (seq? (+ 1 2 3) 6))
(pass-if "*" (seq? (* 3 3 3) 27))
(pass-if "/" (seq? (/ 9 3) 3))
(pass-if "remainder" (seq? (remainder 11 3) 2))
(pass-if "modulo" (seq? (modulo 11 3) 2))
(pass-if "expt" (seq? (expt 2 3) 8))
(pass-if "logior" (seq? (logior 0 1 2 4) 7))
(pass-if-equal "ash"
8 (ash 1 3))
(pass-if-equal "ash -1"
5 (ash 10 -1))
(pass-if "=" (seq? 3 '3))
(pass-if "= 2" (not (= 3 '4)))
(pass-if "=" (seq? (=) #t))
(pass-if "= 1" (seq? (= 0) #t))
(pass-if "= 2" (seq? (= 0 0) #t))
(pass-if "= 3" (seq? (= 0 0) #t))
(pass-if "= 4" (seq? (= 0 1 0) #f))
(pass-if "<" (seq? (<) #t))
(pass-if "< 1" (seq? (< 0) #t))
(pass-if "< 2" (seq? (< 0 1) #t))
(pass-if "< 3" (seq? (< 1 0) #f))
(pass-if "< 4" (seq? (< 0 1 2) #t))
(pass-if "< 5" (seq? (< 0 2 1) #f))
(pass-if ">" (seq? (>) #t))
(pass-if "> 1" (seq? (> 0) #t))
(pass-if "> 2" (seq? (> 1 0) #t))
(pass-if "> 3" (seq? (> 0 1) #f))
(pass-if "> 4" (seq? (> 2 1 0) #t))
(pass-if "> 5" (seq? (> 1 2 0) #f))
(pass-if ">=" (seq? (>= 3 2 1) #t))
(pass-if ">= 2" (seq? (>= 1 2 3) #f))
(pass-if "<=" (seq? (<= 3 2 1) #f))
(pass-if "<= 2" (seq? (<= 1 2 3) #t))
(pass-if "max" (seq? (max 0) 0))
(pass-if "max 1" (seq? (max 0 1) 1))
(pass-if "max 2" (seq? (max 1 0 2) 2))
(pass-if "min" (seq? (min 0) 0))
(pass-if "min 1" (seq? (min 0 1) 0))
(pass-if "min 2" (seq? (min 1 0 2) 0))
(result 'report)

View file

@ -53,21 +53,6 @@ exit $?
(pass-if "+" (seq? (+ 1 2 3) 6))
(pass-if "*" (seq? (* 3 3 3) 27))
(pass-if "/" (seq? (/ 9 3) 3))
(pass-if "remainder" (seq? (remainder 11 3) 2))
(pass-if "modulo" (seq? (modulo 11 3) 2))
(pass-if "expt" (seq? (expt 2 3) 8))
(pass-if "logior" (seq? (logior 0 1 2 4) 7))
(pass-if-equal "ash"
8 (ash 1 3))
(pass-if-equal "ash -1"
5 (ash 10 -1))
(pass-if "=" (seq? 3 '3))
(pass-if "= 2" (not (= 3 '4)))
(pass-if-equal "string-length" (pass-if-equal "string-length"
0 0
(string-length "")) (string-length ""))
@ -149,40 +134,6 @@ exit $?
(pass-if "apply identity 2" (sequal? (apply identity '((0 1))) '(0 1))) (pass-if "apply identity 2" (sequal? (apply identity '((0 1))) '(0 1)))
(pass-if "apply append" (sequal? (apply append '((1 2) (3 4))) '(1 2 3 4))) (pass-if "apply append" (sequal? (apply append '((1 2) (3 4))) '(1 2 3 4)))
(pass-if "=" (seq? (=) #t))
(pass-if "= 1" (seq? (= 0) #t))
(pass-if "= 2" (seq? (= 0 0) #t))
(pass-if "= 3" (seq? (= 0 0) #t))
(pass-if "= 4" (seq? (= 0 1 0) #f))
(pass-if "<" (seq? (<) #t))
(pass-if "< 1" (seq? (< 0) #t))
(pass-if "< 2" (seq? (< 0 1) #t))
(pass-if "< 3" (seq? (< 1 0) #f))
(pass-if "< 4" (seq? (< 0 1 2) #t))
(pass-if "< 5" (seq? (< 0 2 1) #f))
(pass-if ">" (seq? (>) #t))
(pass-if "> 1" (seq? (> 0) #t))
(pass-if "> 2" (seq? (> 1 0) #t))
(pass-if "> 3" (seq? (> 0 1) #f))
(pass-if "> 4" (seq? (> 2 1 0) #t))
(pass-if "> 5" (seq? (> 1 2 0) #f))
(pass-if ">=" (seq? (>= 3 2 1) #t))
(pass-if ">= 2" (seq? (>= 1 2 3) #f))
(pass-if "<=" (seq? (<= 3 2 1) #f))
(pass-if "<= 2" (seq? (<= 1 2 3) #t))
(pass-if "max" (seq? (max 0) 0))
(pass-if "max 1" (seq? (max 0 1) 1))
(pass-if "max 2" (seq? (max 1 0 2) 2))
(pass-if "min" (seq? (min 0) 0))
(pass-if "min 1" (seq? (min 0 1) 0))
(pass-if "min 2" (seq? (min 1 0 2) 0))
(pass-if "char-alphabetic?" (seq? (char-alphabetic? #\a) #t)) (pass-if "char-alphabetic?" (seq? (char-alphabetic? #\a) #t))
(pass-if "char-alphabetic? 2" (seq? (char-alphabetic? #\[) #f)) (pass-if "char-alphabetic? 2" (seq? (char-alphabetic? #\[) #f))