#! /bin/sh # -*-scheme-*- if [ "$MES" != guile ]; then export MES_BOOT=boot-02.scm MES=${MES-$(dirname $0)/../bin/mes} $MES < $0 exit $? else exit 0 fi exec ${MES-bin/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)