tests/scm.test

   1 #! /bin/sh
   2 # -*-scheme-*-
   3 MES=${MES-$(dirname $0)/../scripts/mes}
   4 echo ' ()' | cat $(dirname $0)/../module/mes/base-0.mes $0 /dev/stdin | $MES $MES_FLAGS "$@"
   5 #paredit:||
   6 exit $?
   7 !#
   8
   9 ;;; -*-scheme-*-
  10
  11 ;;; Mes --- Maxwell Equations of Software
  12 ;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
  13 ;;;
  14 ;;; This file is part of Mes.
  15 ;;;
  16 ;;; Mes is free software; you can redistribute it and/or modify it
  17 ;;; under the terms of the GNU General Public License as published by
  18 ;;; the Free Software Foundation; either version 3 of the License, or (at
  19 ;;; your option) any later version.
  20 ;;;
  21 ;;; Mes is distributed in the hope that it will be useful, but
  22 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  23 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 ;;; GNU General Public License for more details.
  25 ;;;
  26 ;;; You should have received a copy of the GNU General Public License
  27 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  28
  29 (mes-use-module (mes scm))
  30 (mes-use-module (srfi srfi-0))
  31 (mes-use-module (mes test))
  32
  33 (pass-if "first dummy" #t)
  34 (pass-if-not "second dummy" #f)
  35
  36 (pass-if "when" (seq? (when #t 'true) 'true))
  37 (pass-if "when 2" (seq? (when #f 'true) *unspecified*))
  38
  39 (pass-if "map" (sequal? (map identity '(1 2 3 4)) '(1 2 3 4)))
  40 (pass-if "map 2 " (sequal? (map (lambda (i a) (cons i a)) '(1 2 3 4) '(a b c d))
  41                            '((1 . a) (2 . b) (3 . c) (4 . d))))
  42 (pass-if "for-each" (sequal? (let ((acc '())) (for-each (lambda (x) (set! acc (cons x acc))) '(1 2 3 4)) acc) '(4 3 2 1)))
  43 (define xxxa 0)
  44 (pass-if "set! " (seq? (begin (set! xxxa 1) xxxa) 1))
  45 (pass-if "set! 2" (seq? (let ((a 0)) (set! a 1) a) 1))
  46
  47
  48 (pass-if "list-ref" (seq? (list-ref '(0 1 2) 1) 1))
  49
  50 (pass-if "do" (sequal? (let ((acc '())) (do ((i 0 (+ i 1))) ((>= i 3)) (set! acc (cons i acc))) acc) '(2 1 0)))
  51
  52
  53
  54
  55
  56
  57 (pass-if-equal "string-length"
  58     0
  59     (string-length ""))
  60 (pass-if-equal "string-length 2"
  61     3
  62   (string-length (string-append "a" "b" "c")))
  63 (pass-if-equal "string->list"
  64     '()
  65     (string->list ""))
  66 (pass-if-equal "string->list 2"
  67     '(#\a #\b #\c #\newline)
  68   (string->list "abc\n"))
  69
  70 (pass-if "string-append" (sequal? (string-append "a" "b" "c") "abc"))
  71 (pass-if "substring" (sequal? (substring "hello world" 6) "world"))
  72 (pass-if "substring 2" (sequal? (substring "hello world" 4 7) "o w"))
  73 (pass-if "string-ref" (seq? (string-ref "hello world" 4) #\o))
  74 (pass-if "eq?" (not (eq? (string-append "a" "b" "c") "abc")))
  75 (pass-if "char" (seq? (char->integer #\A) 65))
  76 (pass-if "char 2" (seq? (char->integer #\101) (char->integer #\A)))
  77 (pass-if "char 3" (seq? (integer->char 10) #\newline))
  78 (pass-if "char 4" (seq? (integer->char 32) #\space))
  79 (pass-if "string " (sequal? (string #\a #\space #\s #\t #\r #\i #\n #\g) "a string"))
  80 (pass-if "length" (seq? (length '()) 0))
  81 (pass-if "length 2" (seq? (length '(a b c)) 3))
  82 (pass-if "make-list" (seq? (make-list 0) '()))
  83 (pass-if "make-list 1" (sequal? (make-list 1 0) '(0)))
  84 (pass-if "memq" (sequal? (memq 'a '(a b c)) '(a b c)))
  85 (pass-if "memq" (sequal? (memq 'b '(a b c)) '(b c)))
  86 (pass-if "memq" (seq? (memq 'd '(a b c)) #f))
  87 (pass-if "member" (sequal? (member '(a) '((a) b c)) '((a) b c)))
  88 (pass-if "assq-ref" (seq? (assq-ref '((b . 1) (c . 2)) 'c) 2))
  89 (pass-if "assq-ref 2" (seq? (assq-ref '((b . 1) (c . 2)) 'a) #f))
  90 (pass-if "assq-set!" (sequal? (assq-set! '((b . 1)) 'a 0) '((a . 0) (b . 1))))
  91 (pass-if "assq-set! 2" (sequal? (assq-set! '((a . 0)) 'a 1) '((a . 1))))
  92 (pass-if "assoc" (sequal? (assoc '(a . 0) '((a . 0) (b . 1) ((a . 0) aa))) '((a . 0) aa)))
  93
  94 (pass-if "builtin? car" (builtin? car))
  95 (pass-if "builtin? cdr" (builtin? cdr))
  96 (pass-if "builtin? cons" (builtin? cons))
  97 (pass-if "builtin? eq?" (builtin? eq?))
  98 (pass-if "builtin? if" (builtin? eq?))
  99 (when (not guile?)
 100   (pass-if "builtin? eval" (not (builtin? not))))
 101 (pass-if "procedure?" (procedure? builtin?))
 102 (pass-if "procedure?" (procedure? procedure?))
 103 (pass-if "gensym"
 104   (symbol? (gensym)))
 105 (pass-if "gensym 1"
 106   (not (eq? (gensym) (gensym))))
 107 (pass-if "gensym 2"
 108   (not (eq? (gensym) (gensym))))
 109
 110 (pass-if "last-pair " (sequal? (last-pair '(1 2 3 4)) '(4)))
 111 (pass-if "last-pair 2" (seq? (last-pair '()) '()))
 112 ;; (pass-if "circular-list? "
 113 ;;   (seq?
 114 ;;    (let ((x (list 1 2 3 4)))
 115 ;;      (set-cdr! (last-pair x) (cddr x))
 116 ;;      (circular-list? x))
 117 ;;    #t))
 118
 119 (pass-if-equal "iota"
 120     '(0 1 2) (iota 3))
 121
 122 (pass-if-equal "iota 0"
 123     '() (iota 0))
 124
 125 (pass-if-equal "iota -1"
 126                '() (iota -1))
 127
 128 (pass-if "reverse" (sequal? (reverse '(1 2 3)) '(3 2 1)))
 129
 130 (pass-if "cond-expand" (sequal? (cond-expand (foobar #f) (mes (display ": pass: *YAY*") 'mes) (guile (display ": pass: *GUILE*") 'mes)) 'mes))
 131
 132 (pass-if "apply identity" (seq? (apply identity '(0)) 0))
 133 (pass-if "apply identity 2" (sequal? (apply identity '((0 1))) '(0 1)))
 134 (pass-if "apply append" (sequal? (apply append '((1 2) (3 4))) '(1 2 3 4)))
 135
 136 (pass-if "char-alphabetic?" (seq? (char-alphabetic? #\a) #t))
 137 (pass-if "char-alphabetic? 2" (seq? (char-alphabetic? #\[) #f))
 138
 139 (pass-if-equal "compose" 1 ((compose car cdr car) '((0 1 2))))
 140
 141 (result 'report)