tests/closure.test

   1 #! /bin/sh
   2 # -*-scheme-*-
   3 echo ' ()' | cat $(dirname $0)/../module/mes/base-0.mes $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@"
   4 #paredit:||
   5 exit $?
   6 !#
   7
   8 ;;; -*-scheme-*-
   9
  10 ;;; Mes --- Maxwell Equations of Software
  11 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
  12 ;;;
  13 ;;; This file is part of Mes.
  14 ;;;
  15 ;;; Mes is free software; you can redistribute it and/or modify it
  16 ;;; under the terms of the GNU General Public License as published by
  17 ;;; the Free Software Foundation; either version 3 of the License, or (at
  18 ;;; your option) any later version.
  19 ;;;
  20 ;;; Mes is distributed in the hope that it will be useful, but
  21 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;;; GNU General Public License for more details.
  24 ;;;
  25 ;;; You should have received a copy of the GNU General Public License
  26 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  27
  28 (mes-use-module (mes test))
  29
  30 (pass-if "first dummy" #t)
  31 (pass-if-not "second dummy" #f)
  32
  33 (define b 0)
  34 (define x (lambda () b))
  35 (define (x) b)
  36 (pass-if "closure" (seq? (x) 0))
  37 (define (c b)
  38   (x))
  39 (pass-if "closure 2" (seq? (c 1) 0))
  40
  41 (define (x)
  42   (define b 1)
  43   (define (y) b)
  44   (set! b 0)
  45   (list b
  46         (let ((b 2))
  47           (y))))
  48
  49 (pass-if "closure 3" (sequal? (x) '(0 0)))
  50
  51 (pass-if "closure 4 "
  52   (seq? (let ()
  53           (let ((count (let ((counter 0))
  54                          (lambda ()
  55                            counter))))
  56             (count)))
  57         0))
  58
  59 (pass-if "closure 5 "
  60          (seq?
  61           (let ()
  62             (define name? 2)
  63             (define (foo)
  64               (define name? 0)
  65               (lambda () name?))
  66             ((foo)))
  67           0))
  68
  69 (pass-if "closure 6 "
  70          (seq?
  71           (let ()
  72             (define foo
  73               (lambda ()
  74                 (define name? symbol?)
  75                 (lambda ()
  76                   (name? 'boo))))
  77             ((foo)))
  78                #t))
  79
  80 (define-macro (foo? q+q)
  81   #t)
  82 (foo? 'cons)
  83 (pass-if-equal "closure 7" #f (defined? 'q+q))
  84
  85 (let ((x 0))
  86   (pass-if-equal "closure 8" #f (not (defined? 'x))))
  87
  88 ((lambda ()
  89    (define sc-expand #f)
  90    ((lambda (g38)
  91       (set! sc-expand
  92             ((lambda ()
  93                (lambda ()
  94                  (list g38))))))
  95     "noexpand")
  96    (pass-if "closure 9" (sc-expand))))
  97
  98 (pass-if "closure is procedure"
  99              (procedure? (lambda () #t)))
 100
 101 (pass-if-not "closure is not a pair"
 102              (pair? (lambda () #t)))
 103
 104 (result 'report)