#! /bin/sh # -*-scheme-*- exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests guile)' -s "$0" "$@" !# ;;; -*-scheme-*- ;;; GNU Mes --- Maxwell Equations of Software ;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen ;;; ;;; 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 . (define-module (tests guile) #:use-module (ice-9 rdelim) #:use-module (mes mes-0) #:use-module (mes misc) #:use-module (mes test)) (cond-expand (mes (mes-use-module (mes test)) (mes-use-module (mes misc)) (mes-use-module (mes guile))) (else)) (pass-if "first dummy" #t) (pass-if-not "second dummy" #f) (pass-if-equal "read-string" "bla" (with-input-from-string "bla" (lambda () (read-string)))) (pass-if-equal "open-input-string" "bla" (let* ((port (current-input-port)) (foo (open-input-string "bla"))) (set-current-input-port foo) (let ((s (read-string))) (set-current-input-port port) s))) ;; NYACC ;; === input stack ===================== (define *input-stack* (make-fluid '())) (define (reset-input-stack) (fluid-set! *input-stack* '())) (define (push-input port) (let ((curr (current-input-port)) (ipstk (fluid-ref *input-stack*))) (fluid-set! *input-stack* (cons curr ipstk)) (set-current-input-port port))) ;; Return #f if empty (define (pop-input) (let ((ipstk (fluid-ref *input-stack*))) (if (null? ipstk) #f (begin (set-current-input-port (car ipstk)) (fluid-set! *input-stack* (cdr ipstk)))))) (pass-if-equal "push-input" "bla" (let () (push-input (open-input-string "bla")) (let ((ch (read-char))) (unread-char ch)) (let ((x (read-string))) (let ((pop (pop-input))) x)))) (pass-if-equal "input-stack/1" "hello world!" (with-output-to-string (lambda () (with-input-from-string "hello X!" (lambda () (let iter ((ch (read-char))) (unless (eq? ch #\X) (write-char ch) (iter (read-char)))) (push-input (open-input-string "world")) (let iter ((ch (read-char))) (unless (eof-object? ch) (write-char ch) (iter (read-char)))) (pop-input) (let iter ((ch (read-char))) (unless (eof-object? ch) (write-char ch) (iter (read-char))))))))) (pass-if "input-stack/2" (let ((sp (open-input-string "abc"))) (push-input sp) (and (pop-input) (not (pop-input))))) (pass-if-equal "with-input-from-string peek" #\X (with-input-from-string "X" (lambda () (peek-char)))) (pass-if-equal "open-input-string peek" #\X (let ((port (open-input-string "X"))) (set-current-input-port port) (peek-char))) (result 'report)