[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/01: Test Scheme port implementation
From: |
Andy Wingo |
Subject: |
[Guile-commits] 01/01: Test Scheme port implementation |
Date: |
Mon, 16 May 2016 12:06:59 +0000 (UTC) |
wingo pushed a commit to branch master
in repository guile.
commit e32dcf214eb140c81c269e17de477e6f1932ee62
Author: Andy Wingo <address@hidden>
Date: Mon May 16 14:04:54 2016 +0200
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.
---
module/ice-9/ports.scm | 1 +
test-suite/Makefile.am | 1 +
test-suite/tests/sports.test | 51 ++++++++++++++++++++++++++++++++++++++++++
3 files changed, 53 insertions(+)
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
index 34191a5..a7f2373 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 41c5549..775a04f 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 0000000..89ec456
--- /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")