test-suite/tests/chars.test

   1 ;;;; chars.test --- test suite for Guile's char functions    -*- scheme -*-
   2 ;;;; Greg J. Badros <gjb@cs.washington.edu>
   3 ;;;;
   4 ;;;;    Copyright (C) 2000, 2006, 2009 Free Software Foundation, Inc.
   5 ;;;;
   6 ;;;; This library is free software; you can redistribute it and/or
   7 ;;;; modify it under the terms of the GNU Lesser General Public
   8 ;;;; License as published by the Free Software Foundation; either
   9 ;;;; version 3 of the License, or (at your option) any later version.
  10 ;;;;
  11 ;;;; This library is distributed in the hope that it will be useful,
  12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 ;;;; Lesser General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU Lesser General Public
  17 ;;;; License along with this library; if not, write to the Free Software
  18 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19
  20 (use-modules (test-suite lib))
  21
  22 (define exception:wrong-type-to-apply
  23   (cons 'misc-error "^Wrong type to apply:"))
  24
  25 (define exception:unknown-character-name
  26   (cons #t "unknown character"))
  27
  28 (define exception:out-of-range-octal
  29   (cons #t "out-of-range"))
  30
  31
  32 (with-test-prefix "basic char handling"
  33
  34   (with-test-prefix "evaluator"
  35
  36     ;; The following test makes sure that the evaluator distinguishes between
  37     ;; evaluator-internal instruction codes and characters.
  38     (pass-if-exception "evaluating chars"
  39       exception:wrong-type-arg
  40       (eval '(#\0) (interaction-environment))))
  41
  42   (with-test-prefix "comparisons"
  43
  44     ;; char=?
  45     (pass-if "char=? #\\A #\\A"
  46       (char=? #\A #\A))
  47
  48     (expect-fail "char=? #\\A #\\a"
  49       (char=? #\A #\a))
  50
  51     (expect-fail "char=? #\\A #\\B"
  52       (char=? #\A #\B))
  53
  54     (expect-fail "char=? #\\B #\\A"
  55       (char=? #\A #\B))
  56
  57     ;; char<?
  58     (expect-fail "char<? #\\A #\\A"
  59       (char<? #\A #\A))
  60
  61     (pass-if "char<? #\\A #\\a"
  62       (char<? #\A #\a))
  63
  64     (pass-if "char<? #\\A #\\B"
  65       (char<? #\A #\B))
  66
  67     (expect-fail "char<? #\\B #\\A"
  68       (char<? #\B #\A))
  69
  70     ;; char<=?
  71     (pass-if "char<=? #\\A #\\A"
  72       (char<=? #\A #\A))
  73
  74     (pass-if "char<=? #\\A #\\a"
  75       (char<=? #\A #\a))
  76
  77     (pass-if "char<=? #\\A #\\B"
  78       (char<=? #\A #\B))
  79
  80     (expect-fail "char<=? #\\B #\\A"
  81       (char<=? #\B #\A))
  82
  83     ;; char>?
  84     (expect-fail "char>? #\\A #\\A"
  85       (char>? #\A #\A))
  86
  87     (expect-fail "char>? #\\A #\\a"
  88       (char>? #\A #\a))
  89
  90     (expect-fail "char>? #\\A #\\B"
  91       (char>? #\A #\B))
  92
  93     (pass-if "char>? #\\B #\\A"
  94       (char>? #\B #\A))
  95
  96     ;; char>=?
  97     (pass-if "char>=? #\\A #\\A"
  98       (char>=? #\A #\A))
  99
 100     (expect-fail "char>=? #\\A #\\a"
 101       (char>=? #\A #\a))
 102
 103     (expect-fail "char>=? #\\A #\\B"
 104       (char>=? #\A #\B))
 105
 106     (pass-if "char>=? #\\B #\\A"
 107       (char>=? #\B #\A))
 108
 109     ;; char-ci=?
 110     (pass-if "char-ci=? #\\A #\\A"
 111       (char-ci=? #\A #\A))
 112
 113     (pass-if "char-ci=? #\\A #\\a"
 114       (char-ci=? #\A #\a))
 115
 116     (expect-fail "char-ci=? #\\A #\\B"
 117       (char-ci=? #\A #\B))
 118
 119     (expect-fail "char-ci=? #\\B #\\A"
 120       (char-ci=? #\A #\B))
 121
 122     ;; char-ci<?
 123     (expect-fail "char-ci<? #\\A #\\A"
 124       (char-ci<? #\A #\A))
 125
 126     (expect-fail "char-ci<? #\\A #\\a"
 127       (char-ci<? #\A #\a))
 128
 129     (pass-if "char-ci<? #\\A #\\B"
 130       (char-ci<? #\A #\B))
 131
 132     (expect-fail "char-ci<? #\\B #\\A"
 133       (char-ci<? #\B #\A))
 134
 135     ;; char-ci<=?
 136     (pass-if "char-ci<=? #\\A #\\A"
 137       (char-ci<=? #\A #\A))
 138
 139     (pass-if "char-ci<=? #\\A #\\a"
 140       (char-ci<=? #\A #\a))
 141
 142     (pass-if "char-ci<=? #\\A #\\B"
 143       (char-ci<=? #\A #\B))
 144
 145     (expect-fail "char-ci<=? #\\B #\\A"
 146       (char-ci<=? #\B #\A))
 147
 148     ;; char-ci>?
 149     (expect-fail "char-ci>? #\\A #\\A"
 150       (char-ci>? #\A #\A))
 151
 152     (expect-fail "char-ci>? #\\A #\\a"
 153       (char-ci>? #\A #\a))
 154
 155     (expect-fail "char-ci>? #\\A #\\B"
 156       (char-ci>? #\A #\B))
 157
 158     (pass-if "char-ci>? #\\B #\\A"
 159       (char-ci>? #\B #\A))
 160
 161     ;; char-ci>=?
 162     (pass-if "char-ci>=? #\\A #\\A"
 163       (char-ci>=? #\A #\A))
 164
 165     (pass-if "char-ci>=? #\\A #\\a"
 166       (char-ci>=? #\A #\a))
 167
 168     (expect-fail "char-ci>=? #\\A #\\B"
 169       (char-ci>=? #\A #\B))
 170
 171     (pass-if "char-ci>=? #\\B #\\A"
 172       (char-ci>=? #\B #\A)))
 173
 174   (with-test-prefix "categories"
 175
 176     (pass-if "char-alphabetic?"
 177       (and (char-alphabetic? #\a)
 178            (char-alphabetic? #\A)
 179            (not (char-alphabetic? #\1))
 180            (not (char-alphabetic? #\+))))
 181
 182     (pass-if "char-numeric?"
 183       (and (not (char-numeric? #\a))
 184            (not (char-numeric? #\A))
 185            (char-numeric? #\1)
 186            (not (char-numeric? #\+))))
 187
 188     (pass-if "char-whitespace?"
 189       (and (not (char-whitespace? #\a))
 190            (not (char-whitespace? #\A))
 191            (not (char-whitespace? #\1))
 192            (char-whitespace? #\space)
 193            (not (char-whitespace? #\+))))
 194
 195     (pass-if "char-upper-case?"
 196       (and (not (char-upper-case? #\a))
 197            (char-upper-case? #\A)
 198            (not (char-upper-case? #\1))
 199            (not (char-upper-case? #\+))))
 200
 201     (pass-if "char-lower-case?"
 202       (and (char-lower-case? #\a)
 203            (not (char-lower-case? #\A))
 204            (not (char-lower-case? #\1))
 205            (not (char-lower-case? #\+))))
 206
 207     (pass-if "char-is-both? works"
 208       (and
 209        (not (char-is-both? #\?))
 210        (not (char-is-both? #\newline))
 211        (char-is-both? #\a)
 212        (char-is-both? #\Z)
 213        (not (char-is-both? #\1))))
 214
 215     (pass-if "char-general-category"
 216       (and (eq? (char-general-category #\a) 'Ll)
 217            (eq? (char-general-category #\A) 'Lu)
 218            (eq? (char-general-category #\762) 'Lt))))
 219
 220   (with-test-prefix "integer"
 221
 222     (pass-if "char->integer"
 223       (eqv? (char->integer #\A) 65))
 224
 225     (pass-if "integer->char"
 226       (eqv? (integer->char 65) #\A))
 227
 228     (pass-if-exception "integer->char out of range, -1" exception:out-of-range
 229       (integer->char -1))
 230
 231     (pass-if-exception "integer->char out of range, surrrogate"
 232                        exception:out-of-range
 233       (integer->char #xd800))
 234
 235     (pass-if-exception "integer->char out of range, too big"
 236                        exception:out-of-range
 237       (integer->char #x110000))
 238
 239     (pass-if-exception "octal out of range, surrrogate"
 240                        exception:out-of-range-octal
 241       (with-input-from-string "#\\154000" read))
 242
 243     (pass-if-exception "octal out of range, too big"
 244                        exception:out-of-range-octal
 245       (with-input-from-string "#\\4200000" read)))
 246
 247   (with-test-prefix "case"
 248
 249     (pass-if "char-upcase"
 250       (eqv? (char-upcase #\a) #\A))
 251
 252     (pass-if "char-downcase"
 253       (eqv? (char-downcase #\A) #\a))
 254
 255     (pass-if "char-titlecase"
 256       (and (eqv? (char-titlecase #\a) #\A)
 257            (eqv? (char-titlecase #\763) #\762))))
 258
 259   (with-test-prefix "charnames"
 260
 261     (pass-if "R5RS character names are case insensitive"
 262       (and (eqv? #\space #\ )
 263            (eqv? #\SPACE #\ )
 264            (eqv? #\Space #\ )
 265            (eqv? #\newline (integer->char 10))
 266            (eqv? #\NEWLINE (integer->char 10))
 267            (eqv? #\Newline (integer->char 10))))
 268
 269     (pass-if "C0 control names are case insensitive"
 270       (and (eqv? #\nul #\000)
 271            (eqv? #\soh #\001)
 272            (eqv? #\stx #\002)
 273            (eqv? #\NUL #\000)
 274            (eqv? #\SOH #\001)
 275            (eqv? #\STX #\002)
 276            (eqv? #\Nul #\000)
 277            (eqv? #\Soh #\001)
 278            (eqv? #\Stx #\002)))
 279
 280     (pass-if "alt charnames are case insensitive"
 281       (eqv? #\null #\nul)
 282       (eqv? #\NULL #\nul)
 283       (eqv? #\Null #\nul))
 284
 285     (pass-if-exception "bad charname" exception:unknown-character-name
 286       (with-input-from-string "#\\blammo" read))
 287
 288     (pass-if "R5RS character names are preferred write format"
 289       (string=?
 290        (with-output-to-string (lambda () (write #\space)))
 291        "#\\space"))
 292
 293     (pass-if "C0 control character names are preferred write format"
 294       (string=?
 295        (with-output-to-string (lambda () (write #\soh)))
 296        "#\\soh"))))
 297