1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
;;; Copyright (C) 2023, 2025 Igalia, S.L.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Commentary:
;;;
;;; String tests.
;;;
;;; Code:
(use-modules (srfi srfi-64)
(test utils))
(test-begin "test-write")
(define-syntax test-write
(syntax-rules ()
((_ datum) (test-write (object->string datum) datum))
((_ expected-output datum)
(test-write expected-output expected-output datum)
)
((_ scheme-repr reflect-repr datum)
(let ((output (string-append scheme-repr reflect-repr)))
(with-additional-imports ((scheme write))
(test-call output
(lambda (x)
(write x (current-output-port))
(flush-output-port (current-output-port))
x)
datum))))))
(test-write #f)
(test-write #t)
(test-write #nil)
(test-write '())
(test-write (if #f #f))
(let ((eof-object (lambda () the-eof-object)))
(test-write (eof-object)))
(test-write 42)
(test-write -42)
(test-write 42.0)
(test-write -42.0)
(test-write #\a)
(test-write '(1 . 2))
(test-write '(1 2))
(test-write "foo")
(test-write 'foo)
(test-write #vu8())
(test-write #vu8(1 2 3))
(test-write #())
(test-write #(1 2 3))
(test-write #*)
(test-write #*110110)
(test-write "#<procedure>" (lambda () 42))
(test-write #:foo)
(test-write "#<port>" (open-input-string "foo"))
;; Not yet implemented:
;; Boxes
;; Atomic boxes
;; Weak tables
;; Fluids
;; Dynamic states
;; Syntax
;; Structs / records
;; Parameters
(test-end* "test-write")
|
