1;;;; Scheme implementation of Guile ports -*- scheme -*-
2;;;;
3;;;; Copyright (C) 2016 Free Software Foundation, Inc.
4;;;;
5;;;; This library is free software: you can redistribute it and/or modify
6;;;; it under the terms of the GNU Lesser General Public License as
7;;;; published by the Free Software Foundation, either version 3 of the
8;;;; License, or (at your option) any later version.
9;;;;
10;;;; This library is distributed in the hope that it will be useful,
11;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13;;;; GNU Lesser General Public License for more details.
14;;;;
15;;;; You should have received a copy of the GNU Lesser General Public
16;;;; License along with this library.  If not, see
17;;;; <http://www.gnu.org/licenses/>.
18
19(define-module (test-suite test-ports)
20  #:use-module (ice-9 suspendable-ports))
21
22;; Include tests from ports.test.
23
24(define-syntax import-uses
25  (syntax-rules ()
26    ((_) #t)
27    ((_ #:use-module mod . uses)
28     (begin (use-modules mod) (import-uses . uses)))))
29
30(define-syntax include-one
31  (syntax-rules (define-module)
32    ((_ (define-module mod . uses))
33     (import-uses . uses))
34    ((_ exp) exp)))
35
36(define-syntax include-tests
37  (lambda (x)
38    (syntax-case x ()
39      ((include-tests file)
40       (call-with-input-file (in-vicinity (getenv "TEST_SUITE_DIR")
41                                          (syntax->datum #'file))
42         (lambda (port)
43           #`(begin
44               . #,(let lp ()
45                     (let ((exp (read port)))
46                       (if (eof-object? exp)
47                           #'()
48                           (let ((exp (datum->syntax #'include-tests exp)))
49                             #`((include-one #,exp) . #,(lp))))))))
50         #:guess-encoding #t)))))
51
52(install-suspendable-ports!)
53
54(include-tests "tests/ports.test")
55(include-tests "tests/rdelim.test")
56(include-tests "tests/r6rs-ports.test")
57
58(uninstall-suspendable-ports!)
59