1;; Filename : test-srfi28.scm 2;; About : unit test for SRFI-28 3;; 4;; Copyright (C) 2006 YAMAMOTO Kengo <yamaken AT bp.iij4u.or.jp> 5;; Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com> 6;; 7;; All rights reserved. 8;; 9;; Redistribution and use in source and binary forms, with or without 10;; modification, are permitted provided that the following conditions 11;; are met: 12;; 13;; 1. Redistributions of source code must retain the above copyright 14;; notice, this list of conditions and the following disclaimer. 15;; 2. Redistributions in binary form must reproduce the above copyright 16;; notice, this list of conditions and the following disclaimer in the 17;; documentation and/or other materials provided with the distribution. 18;; 3. Neither the name of authors nor the names of its contributors 19;; may be used to endorse or promote products derived from this software 20;; without specific prior written permission. 21;; 22;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS 23;; IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, 24;; THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 25;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR 26;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 27;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 28;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 29;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 30;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 31;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 32;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 33 34;; All tests in this file are passed against r3166 (new repository) 35 36(require-extension (unittest)) 37 38(require-extension (srfi 28)) 39 40(if (not (provided? "srfi-28")) 41 (test-skip "SRFI-28 is not enabled")) 42 43(define tn test-name) 44 45(tn "format invalid form") 46(assert-error (tn) (lambda () (format))) 47(assert-error (tn) (lambda () (format #f))) 48(assert-error (tn) (lambda () (format #\a))) 49(assert-error (tn) (lambda () (format "~"))) 50(assert-error (tn) (lambda () (format "a~"))) 51(assert-error (tn) (lambda () (format "a" "a"))) 52 53(tn "format unknown directives") 54(assert-error (tn) (lambda () (format "~z"))) 55(assert-error (tn) (lambda () (format "~Z"))) 56(assert-error (tn) (lambda () (format "~'"))) 57(assert-error (tn) (lambda () (format "~$"))) 58 59(tn "format SRFI-48 directives") 60(if (not (provided? "srfi-48")) 61 (begin 62 (assert-error (tn) (lambda () (format "~w" 0))) 63 (assert-error (tn) (lambda () (format "~d" 0))) 64 (assert-error (tn) (lambda () (format "~x" 0))) 65 (assert-error (tn) (lambda () (format "~o" 0))) 66 (assert-error (tn) (lambda () (format "~b" 0))) 67 (assert-error (tn) (lambda () (format "~c" #\a))) 68 (assert-error (tn) (lambda () (format "~f" 0))) 69 (assert-error (tn) (lambda () (format "~2f" 0))) 70 (assert-error (tn) (lambda () (format "~2,3f" 0))) 71 (assert-error (tn) (lambda () (format "~?" "~s" '(0)))) 72 (assert-error (tn) (lambda () (format "~k" "~s" '(0)))) 73 (assert-error (tn) (lambda () (format "~y" '(0)))) 74 75 (assert-error (tn) (lambda () (format "~t"))) 76 (assert-error (tn) (lambda () (format "~_"))) 77 (assert-error (tn) (lambda () (format "~&"))) 78 (assert-error (tn) (lambda () (format "~h"))))) 79 80(tn "format no directive") 81(assert-error (tn) (lambda () (format "" 0))) 82(assert-equal? (tn) 83 "" 84 (format "")) 85(assert-equal? (tn) 86 "aBc" 87 (format "aBc")) 88 89(tn "format ~a") 90(assert-error (tn) (lambda () (format "~a"))) 91(assert-error (tn) (lambda () (format "~a" 0 1))) 92(assert-error (tn) (lambda () (format "~1a" 1))) 93(assert-equal? (tn) 94 (if (and (provided? "sigscheme") 95 (provided? "siod-bugs")) 96 "()" 97 "#f") 98 (format "~a" #f)) 99(assert-equal? (tn) 100 "#t" 101 (format "~a" #t)) 102(assert-equal? (tn) 103 "123" 104 (format "~a" 123)) 105(assert-equal? (tn) 106 "a" 107 (format "~a" #\a)) 108(assert-equal? (tn) 109 "aBc" 110 (format "~a" "aBc")) 111(assert-equal? (tn) 112 "(#t 123 a aBc (0))" 113 (format "~a" '(#t 123 #\a "aBc" (0)))) 114 115(tn "format ~A") 116(assert-error (tn) (lambda () (format "~A"))) 117(assert-error (tn) (lambda () (format "~A" 0 1))) 118(assert-error (tn) (lambda () (format "~1A" 1))) 119(assert-equal? (tn) 120 (if (and (provided? "sigscheme") 121 (provided? "siod-bugs")) 122 "()" 123 "#f") 124 (format "~A" #f)) 125(assert-equal? (tn) 126 "#t" 127 (format "~A" #t)) 128(assert-equal? (tn) 129 "123" 130 (format "~A" 123)) 131(assert-equal? (tn) 132 "a" 133 (format "~A" #\a)) 134(assert-equal? (tn) 135 "aBc" 136 (format "~A" "aBc")) 137(assert-equal? (tn) 138 "(#t 123 a aBc (0))" 139 (format "~A" '(#t 123 #\a "aBc" (0)))) 140 141(tn "format ~s") 142(assert-error (tn) (lambda () (format "~s"))) 143(assert-error (tn) (lambda () (format "~s" 0 1))) 144(assert-error (tn) (lambda () (format "~1s" 1))) 145(assert-equal? (tn) 146 (if (and (provided? "sigscheme") 147 (provided? "siod-bugs")) 148 "()" 149 "#f") 150 (format "~s" #f)) 151(assert-equal? (tn) 152 "#t" 153 (format "~s" #t)) 154(assert-equal? (tn) 155 "123" 156 (format "~s" 123)) 157(assert-equal? (tn) 158 "#\\a" 159 (format "~s" #\a)) 160(assert-equal? (tn) 161 "\"aBc\"" 162 (format "~s" "aBc")) 163(assert-equal? (tn) 164 "(#t 123 #\\a \"aBc\" (0))" 165 (format "~s" '(#t 123 #\a "aBc" (0)))) 166 167(tn "format ~S") 168(assert-error (tn) (lambda () (format "~S"))) 169(assert-error (tn) (lambda () (format "~S" 0 1))) 170(assert-error (tn) (lambda () (format "~1S" 1))) 171(assert-equal? (tn) 172 (if (and (provided? "sigscheme") 173 (provided? "siod-bugs")) 174 "()" 175 "#f") 176 (format "~S" #f)) 177(assert-equal? (tn) 178 "#t" 179 (format "~S" #t)) 180(assert-equal? (tn) 181 "123" 182 (format "~S" 123)) 183(assert-equal? (tn) 184 "#\\a" 185 (format "~S" #\a)) 186(assert-equal? (tn) 187 "\"aBc\"" 188 (format "~S" "aBc")) 189(assert-equal? (tn) 190 "(#t 123 #\\a \"aBc\" (0))" 191 (format "~S" '(#t 123 #\a "aBc" (0)))) 192 193(tn "format ~%") 194(assert-error (tn) (lambda () (format "~%" 0))) 195(assert-equal? (tn) 196 "\n" 197 (format "~%")) 198 199(tn "format ~~") 200(assert-error (tn) (lambda () (format "~~" 0))) 201(assert-equal? (tn) 202 "~" 203 (format "~~")) 204 205(tn "format mixed directives") 206(assert-equal? (tn) 207 "~\n" 208 (format "~~~%")) 209(assert-equal? (tn) 210 "slashified: #\\a\nany: a\n" 211 (format "slashified: ~s~%any: ~a~%" #\a #\a)) 212 213(if (not (provided? "srfi-48")) 214 (total-report)) 215