From 9896f9eb924ddf182426dbdcd94e0583f0e5fedd Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sun, 2 Apr 2017 11:34:40 +0200 Subject: [PATCH] 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 --- GNUmakefile | 3 +- module/mes/base-0.mes | 2 -- module/mes/scm.mes | 2 ++ tests/math.test | 81 +++++++++++++++++++++++++++++++++++++++++++ tests/scm.test | 49 -------------------------- 5 files changed, 85 insertions(+), 52 deletions(-) create mode 100755 tests/math.test diff --git a/GNUmakefile b/GNUmakefile index 9e648250..5fc75d7d 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -57,10 +57,11 @@ TESTS:=\ tests/closure.test\ tests/quasiquote.test\ tests/let.test\ - tests/vector.test\ tests/scm.test\ tests/display.test\ tests/cwv.test\ + tests/math.test\ + tests/vector.test\ tests/srfi-1.test\ tests/srfi-13.test\ tests/srfi-14.test\ diff --git a/module/mes/base-0.mes b/module/mes/base-0.mes index 4ed7f483..b505012d 100644 --- a/module/mes/base-0.mes +++ b/module/mes/base-0.mes @@ -35,8 +35,6 @@ (define (primitive-eval e) (core:eval e (current-module))) (define eval core:eval) -(define quotient /) - (define-macro (defined? x) (list 'assq x '(cddr (current-module)))) diff --git a/module/mes/scm.mes b/module/mes/scm.mes index 917ce765..56906640 100644 --- a/module/mes/scm.mes +++ b/module/mes/scm.mes @@ -282,6 +282,8 @@ ;;; Math +(define quotient /) + (define (<= . rest) (or (apply < rest) (apply = rest))) diff --git a/tests/math.test b/tests/math.test new file mode 100755 index 00000000..4ec79a1e --- /dev/null +++ b/tests/math.test @@ -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 +;;; +;;; 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 . + +(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) diff --git a/tests/scm.test b/tests/scm.test index 27b37571..d895e190 100755 --- a/tests/scm.test +++ b/tests/scm.test @@ -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" 0 (string-length "")) @@ -149,40 +134,6 @@ exit $? (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 "=" (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? 2" (seq? (char-alphabetic? #\[) #f))