tests/closure.test

   1 #! /bin/sh
   2 # -*-scheme-*-
   3 echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@"
   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 ;;; closure.test: 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 base-0))
  29 (mes-use-module (mes base))
  30 (mes-use-module (mes test))
  31
  32 (pass-if "first dummy" #t)
  33 (pass-if-not "second dummy" #f)
  34
  35 (define b 0)
  36 (define x (lambda () b))
  37 (define (x) b)
  38 (pass-if "closure" (seq? (x) 0))
  39 (define (c b)
  40   (x))
  41 (pass-if "closure 2" (seq? (c 1) 0))
  42
  43 (define (x)
  44   (define b 1)
  45   (define (y) b)
  46   (set! b 0)
  47   (list b
  48         (let ((b 2))
  49           (y))))
  50
  51 (pass-if "closure 3" (sequal? (x) '(0 0)))
  52
  53 (pass-if "closure 4 "
  54   (seq? (let ()
  55           (let ((count (let ((counter 0))
  56                          (lambda ()
  57                            counter))))
  58             (count)))
  59         0))
  60
  61 (pass-if "closure 5 "
  62          (seq?
  63           (let ()
  64             (define name? 2)
  65             (define (foo)
  66               (define name? 0)
  67               (lambda () name?))
  68             ((foo)))
  69           0))
  70
  71 (pass-if "closure 6 "
  72          (seq?
  73           (let ()
  74             (define foo
  75               (lambda ()
  76                 (define name? symbol?)
  77                 (lambda ()
  78                   (name? 'boo))))
  79             ((foo)))
  80                #t))
  81
  82 (define-macro (foo? q+q)
  83   #t)
  84 (foo? 'cons)
  85 (pass-if-equal "closure 7" #f (defined? 'q+q))
  86
  87 (let ((x 0))
  88   (pass-if-equal "closure 8" #f (not (defined? 'x))))
  89
  90 ((lambda ()
  91    (define sc-expand #f)
  92    ((lambda (g38)
  93       (set! sc-expand
  94             ((lambda ()
  95                (lambda ()
  96                  (list g38))))))
  97     "noexpand")
  98    (pass-if "closure 9" (sc-expand))))
  99
 100 (result 'report)