test-suite/tests/print.test

   1 ;;;; -*- coding: utf-8; 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, write to the Free Software
  17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18
  19 (define-module (test-suite test-print)
  20   #:use-module (ice-9 pretty-print)
  21   #:use-module (test-suite lib))
  22
  23 (define-syntax prints?
  24   ;; #t if EXP prints as RESULT.
  25   (syntax-rules ()
  26     ((_ exp result)
  27      (string=? result
  28                (with-output-to-string
  29                  (lambda ()
  30                    (pretty-print 'exp)))))))
  31
  32 \f
  33 (with-test-prefix "pretty-print"
  34
  35   (pass-if "pair"
  36     (prints? (a . b) "(a . b)\n"))
  37
  38   (pass-if "list"
  39     (prints? (a b c) "(a b c)\n"))
  40
  41   (pass-if "dotted list"
  42     (prints? (a b . c) "(a b . c)\n"))
  43
  44   (pass-if "quote"
  45     (prints? 'foo "'foo\n"))
  46
  47   (pass-if "non-starting quote"
  48     (prints? (foo 'bar) "(foo 'bar)\n"))
  49
  50   (pass-if "nested quote"
  51     (prints? (''foo) "(''foo)\n"))
  52
  53   (pass-if "quasiquote & co."
  54     (prints?  (define foo `(bar ,(+ 2 3)))
  55              "(define foo `(bar ,(+ 2 3)))\n")))
  56
  57 \f
  58 (with-test-prefix "truncated-print"
  59   (define exp '(a b #(c d e) f . g))
  60
  61   (define (tprint x width encoding)
  62     (with-fluids ((%default-port-encoding encoding))
  63       (with-output-to-string
  64         (lambda ()
  65           (truncated-print x #:width width)))))
  66
  67   (pass-if (equal? (tprint exp 10 "ISO-8859-1")
  68                    "(a b . #)"))
  69
  70   (pass-if (equal? (tprint exp 15 "ISO-8859-1")
  71                    "(a b # f . g)"))
  72
  73   (pass-if (equal? (tprint exp 18 "ISO-8859-1")
  74                    "(a b #(c ...) . #)"))
  75
  76   (pass-if (equal? (tprint exp 20 "ISO-8859-1")
  77                    "(a b #(c d e) f . g)"))
  78
  79   (pass-if (equal? (tprint "The quick brown fox" 20 "ISO-8859-1")
  80                    "\"The quick brown...\""))
  81
  82   (pass-if (equal? (tprint "The quick brown fox" 20 "UTF-8")
  83                    "\"The quick brown f…\""))
  84
  85   (pass-if (equal? (tprint (current-module) 20 "ISO-8859-1")
  86                    "#<directory (tes...>"))
  87
  88   (pass-if (equal? (tprint (current-module) 20 "UTF-8")
  89                    "#<directory (test-…>")))