;;;; -*- coding: utf-8; mode: scheme; -*- ;;;; ;;;; Copyright (C) 2010, 2014 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, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (test-suite test-print) #:use-module (ice-9 pretty-print) #:use-module (test-suite lib)) (define-syntax prints? ;; #t if EXP prints as RESULT. (syntax-rules () ((_ exp result) (string=? result (with-output-to-string (lambda () (pretty-print 'exp))))))) (define (with-print-options opts thunk) (let ((saved-options (print-options))) (dynamic-wind (lambda () (print-options opts)) thunk (lambda () (print-options saved-options))))) (define-syntax-rule (write-with-options opts x) (with-print-options opts (lambda () (with-output-to-string (lambda () (write x)))))) (with-test-prefix "write" (with-test-prefix "r7rs-symbols" (pass-if-equal "basic" "|foo bar|" (write-with-options '(r7rs-symbols) (string->symbol "foo bar"))) (pass-if-equal "escapes" "|bar \\| backslash \\x5c; alarm \\a backspace \\b tab \\t newline \\n cr \\r null \\x0; del \\x7f;|" (write-with-options '(r7rs-symbols) (string->symbol (string-append "bar | backslash \\ alarm \a backspace \b tab \t newline \n cr \r null \0 del " (string #\del))))) (pass-if-equal "brackets" "|()[]{}|" (write-with-options '(r7rs-symbols) (string->symbol "()[]{}"))) (pass-if-equal "starts with bar" "|\\|foo|" (write-with-options '(r7rs-symbols) (string->symbol "|foo"))) (pass-if-equal "ends with bar" "|foo\\||" (write-with-options '(r7rs-symbols) (string->symbol "foo|"))) (pass-if-equal "starts with backslash" "|\\x5c;foo|" (write-with-options '(r7rs-symbols) (string->symbol "\\foo"))) (pass-if-equal "ends with backslash" "|foo\\x5c;|" (write-with-options '(r7rs-symbols) (string->symbol "foo\\"))))) (with-test-prefix "pretty-print" (pass-if "pair" (prints? (a . b) "(a . b)\n")) (pass-if "list" (prints? (a b c) "(a b c)\n")) (pass-if "dotted list" (prints? (a b . c) "(a b . c)\n")) (pass-if "quote" (prints? 'foo "'foo\n")) (pass-if "non-starting quote" (prints? (foo 'bar) "(foo 'bar)\n")) (pass-if "nested quote" (prints? (''foo) "(''foo)\n")) (pass-if "quasiquote & co." (prints? (define foo `(bar ,(+ 2 3))) "(define foo `(bar ,(+ 2 3)))\n"))) (with-test-prefix "truncated-print" (define exp '(a b #(c d e) f . g)) (define (tprint x width encoding) (with-fluids ((%default-port-encoding encoding)) (with-output-to-string (lambda () (truncated-print x #:width width))))) (pass-if (equal? (tprint exp 10 "ISO-8859-1") "(a b . #)")) (pass-if (equal? (tprint exp 15 "ISO-8859-1") "(a b # f . g)")) (pass-if (equal? (tprint exp 18 "ISO-8859-1") "(a b #(c ...) . #)")) (pass-if (equal? (tprint exp 20 "ISO-8859-1") "(a b #(c d e) f . g)")) (pass-if (equal? (tprint "The quick brown fox" 20 "ISO-8859-1") "\"The quick brown...\"")) (pass-if (equal? (tprint "The quick brown fox" 20 "UTF-8") "\"The quick brown f…\"")) (pass-if (equal? (tprint (current-module) 20 "ISO-8859-1") "#")) (pass-if (equal? (tprint (current-module) 20 "UTF-8") "#")))