mes/tests/macro.test

#! /bin/sh
# -*-scheme-*-
if [ "$MES" != guile ]; then
    export MES_BOOT=boot-02.scm
    MES=${MES-$(dirname $0)/../src/mes}
    $MES < $0
    exit $?
else
    exit 0
fi
exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests macro)' -s "$0" "$@"
!#

;;; -*-scheme-*-

;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Mes.
;;;
;;; GNU 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.
;;;
;;; GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.

(define-module (tests boot)
  #:use-module (mes mes-0)
  #:use-module (mes test))

(cond-expand
 (mes
  (primitive-load "module/mes/test.scm"))
 (guile-2)
 (guile
  (use-modules (ice-9 syncase))))

(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)

(define gensym
  ((lambda (symbols)
     (lambda (. rest)
       ((lambda (head tail)
          (set! symbols tail)
          head)
        (car symbols)
        (cdr symbols))))
   '(g0 g1 g2 g3 g4)))

;; type-0.mes
(define (string . lst)
  (list->string lst))

;; scm.mes
(define (symbol-append . rest)
  (string->symbol (apply string-append (map symbol->string rest))))

(define-macro (make-fluid . default)
  ((lambda (fluid)
     (list
      'begin
      (list
       'module-define!
       (list 'boot-module)
       (list 'quote fluid)
       (list
        (lambda (v)
          (lambda ( . rest)
            (if (null? rest) v
                (set! v (car rest)))))
        (and (pair? default) (car default))))
      (list 'quote fluid)))
   (symbol-append 'fluid: (gensym))))

(define fluid (make-fluid 42))

(pass-if-eq "fluid" 42 (fluid))

(fluid 0)
(pass-if-eq "fluid 0" 0 (fluid))

(fluid '())
(pass-if-eq "fluid null" '() (fluid))

(define (fluid-ref fluid)
  (fluid))

(define (fluid-set! fluid value)
  (fluid value))

(fluid-set! fluid 0)
(pass-if-eq "fluid 0" 0 (fluid-ref fluid))

(fluid-set! fluid '())
(pass-if-eq "fluid null" '() (fluid-ref fluid))

(result 'report)