summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2016-05-16 14:04:54 +0200
committerAndy Wingo <wingo@pobox.com>2016-05-16 14:04:54 +0200
commite32dcf214eb140c81c269e17de477e6f1932ee62 (patch)
tree722b2d0d62d71343664e7e8ba3f5f5af18cc4658
parent1e058add7b9568fb3a37e4fa82360d183d0a26ee (diff)
downloadguile-e32dcf214eb140c81c269e17de477e6f1932ee62.tar.gz
Test Scheme port implementation
* module/ice-9/ports.scm: Add port-decode-char to internals export list. * test-suite/Makefile.am: * test-suite/tests/sports.test: Add new test.
-rw-r--r--module/ice-9/ports.scm1
-rw-r--r--test-suite/Makefile.am1
-rw-r--r--test-suite/tests/sports.test51
3 files changed, 53 insertions, 0 deletions
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
index 34191a546..a7f237347 100644
--- a/module/ice-9/ports.scm
+++ b/module/ice-9/ports.scm
@@ -178,6 +178,7 @@ interpret its input and output."
%port-encoding
specialize-port-encoding!
port-random-access?
+ port-decode-char
port-read-buffering))
(define-syntax-rule (port-buffer-bytevector buf) (vector-ref buf 0))
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 41c5549cc..775a04f07 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -127,6 +127,7 @@ SCM_TESTS = tests/00-initial-env.test \
tests/session.test \
tests/signals.test \
tests/sort.test \
+ tests/sports.test \
tests/srcprop.test \
tests/srfi-1.test \
tests/srfi-6.test \
diff --git a/test-suite/tests/sports.test b/test-suite/tests/sports.test
new file mode 100644
index 000000000..89ec4569d
--- /dev/null
+++ b/test-suite/tests/sports.test
@@ -0,0 +1,51 @@
+;;;; Scheme implementation of Guile ports -*- scheme -*-
+;;;;
+;;;; Copyright (C) 2016 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU Lesser General Public License as
+;;;; published by the Free Software Foundation, either version 3 of the
+;;;; License, or (at your option) any later version.
+;;;;
+;;;; This library 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 Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library. If not, see
+;;;; <http://www.gnu.org/licenses/>.
+
+(define-module (test-suite test-ports)
+ #:use-module (ice-9 sports))
+
+;; Include tests from ports.test.
+
+(define-syntax import-uses
+ (syntax-rules ()
+ ((_) #t)
+ ((_ #:use-module mod . uses)
+ (begin (use-modules mod) (import-uses . uses)))))
+
+(define-syntax include-one
+ (syntax-rules (define-module)
+ ((_ (define-module mod . uses))
+ (import-uses . uses))
+ ((_ exp) exp)))
+
+(define-syntax include-tests
+ (lambda (x)
+ (syntax-case x ()
+ ((include-tests file)
+ (call-with-input-file (in-vicinity (getenv "TEST_SUITE_DIR")
+ (syntax->datum #'file))
+ (lambda (port)
+ #`(begin
+ . #,(let lp ()
+ (let ((exp (read port)))
+ (if (eof-object? exp)
+ #'()
+ (let ((exp (datum->syntax #'include-tests exp)))
+ #`((include-one #,exp) . #,(lp)))))))))))))
+
+(include-tests "tests/ports.test")