Commit | Line | Data |
---|---|---|
12708eeb AR |
1 | ;;; srfi-38.test --- Tests for SRFI 38. -*- mode: scheme; -*- |
2 | ||
3 | ;; Copyright (C) 2010 Free Software Foundation, Inc. | |
4 | ||
5 | ;; This library is free software; you can redistribute it and/or | |
6 | ;; modify it under the terms of the GNU Lesser General Public | |
7 | ;; License as published by the Free Software Foundation; either | |
8 | ;; version 3 of the 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 GNU | |
13 | ;; 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 | ;;; Code: | |
20 | ||
21 | (define-module (test-srfi-38) | |
22 | #:use-module (test-suite lib) | |
23 | #:use-module (srfi srfi-38) | |
24 | #:use-module (rnrs bytevectors)) | |
25 | ||
26 | (define (shared-structure->string object) | |
27 | (call-with-output-string | |
28 | (lambda (port) | |
29 | (write-with-shared-structure object port)))) | |
30 | ||
31 | (define (roundtrip object) | |
32 | (call-with-input-string (shared-structure->string object) | |
33 | (lambda (port) | |
34 | (read-with-shared-structure port)))) | |
35 | ||
36 | (with-test-prefix "pairs" | |
37 | (let ((foo (cons 'value-1 #f))) | |
38 | (set-cdr! foo foo) | |
39 | (pass-if "writing" | |
40 | (string=? "#1=(value-1 . #1#)" | |
41 | (shared-structure->string foo))) | |
42 | (pass-if "roundtrip" | |
43 | (let ((result (roundtrip foo))) | |
44 | (and (pair? result) | |
45 | (eq? (car result) 'value-1) | |
46 | (eq? (cdr result) result)))))) | |
47 | ||
48 | (with-test-prefix "bytevectors" | |
49 | (let ((vec (vector 0 1 2 3)) | |
50 | (bv (u8-list->bytevector '(42 42)))) | |
51 | (vector-set! vec 0 bv) | |
52 | (vector-set! vec 2 bv) | |
53 | (pass-if "roundtrip" | |
54 | (let ((result (roundtrip vec))) | |
55 | (and (equal? '#(#vu8(42 42) 1 #vu8(42 42) 3) | |
56 | result) | |
57 | (eq? (vector-ref result 0) | |
58 | (vector-ref result 2))))))) | |
59 | ||
60 | (with-test-prefix "mixed" | |
61 | (let* ((pair (cons 'a 'b)) | |
62 | (vec (vector 0 pair 2 pair #f))) | |
63 | (vector-set! vec 4 vec) | |
64 | (pass-if "roundtrip" | |
65 | (let ((result (roundtrip vec))) | |
66 | (and (eq? (vector-ref result 1) | |
67 | (vector-ref result 3)) | |
68 | (eq? result (vector-ref result 4))))))) |