tests/uchars.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- uchars test suite.
   4 ;;;
   5
   6 (in-package :iolib-tests)
   7
   8 (in-suite :iolib.base.uchars)
   9 \f
  10
  11 (test code-uchar.1
  12   (is (eql #x1234 (code-uchar #x1234))))
  13
  14 (test code-uchar.error.1
  15   (signals type-error
  16     (code-uchar uchar-code-limit)))
  17 \f
  18
  19 (test uchar-code.1
  20   (is (eql #x1234 (uchar-code #x1234))))
  21
  22 (test uchar-code.error.1
  23   (signals type-error
  24     (uchar-code uchar-code-limit)))
  25 \f
  26
  27 (test char-to-uchar.1
  28   (is (eql 49 (char-to-uchar #\1))))
  29 \f
  30
  31 (test uchar-to-char.1
  32   (is (char= #\1 (uchar-to-char 49))))
  33
  34 (test uchar-to-char.error.1
  35   (signals type-error
  36     (uchar-to-char uchar-code-limit)))
  37 \f
  38
  39 (test name-uchar.1
  40   (is (eql (char-to-uchar #\space) (name-uchar "Space"))))
  41
  42 (test name-uchar.2
  43   (is (eql #xD800 (name-uchar "Non-Unicode uchar #xD800"))))
  44
  45 (test name-uchar.error.1
  46   (is-false (name-uchar "This is not a uchar name")))
  47 \f
  48
  49 (test uchar-name.1
  50   (is (string-equal "Space" (uchar-name (char-to-uchar #\space)))))
  51
  52 (test uchar-name.2
  53   (is (string-equal "Non-Unicode uchar #xD800"
  54                     (uchar-name #xD800))))
  55 \f
  56
  57 (test digit-uchar.1
  58   (is (eql (+ #x30 9) (digit-uchar 9))))
  59
  60 (test digit-uchar.2
  61   (is (loop :for i :below 16 :always (digit-uchar i 16))))
  62
  63 (test digit-uchar.3
  64   (is-true
  65    (loop :for i :from 0 :to 255
  66          :always (eql (digit-uchar i)
  67                       (if-let (char (digit-char i))
  68                         (char-to-uchar char))))))
  69
  70 (test digit-uchar.error.1
  71   (is-false (digit-uchar 16 16)))
  72
  73 (test digit-uchar.error.2
  74   (signals type-error
  75     (digit-uchar "string")))
  76 \f
  77
  78 (test uchar.1
  79   (is (eql 9 (uchar 9))))
  80
  81 (test uchar.2
  82   (is (eql 9 (uchar (make-array 1 :element-type 'uchar :initial-element 9)))))
  83
  84 (test uchar.3
  85   (is (eql 65 (uchar #\A))))
  86
  87 (test uchar.4
  88   (is (eql 65 (uchar "A"))))
  89
  90 (test uchar.5
  91   (is (eql 65 (uchar 'a))))
  92
  93 (test uchar.error.1
  94   (signals type-error
  95     (uchar uchar-code-limit)))
  96
  97 (test uchar.error.2
  98   (signals type-error
  99     (uchar -1)))
 100
 101 (test uchar.error.3
 102   (signals type-error
 103     (uchar (make-array 2 :element-type 'uchar :initial-element 9))))
 104
 105 (test uchar.error.4
 106   (signals type-error
 107     (uchar "FOO")))
 108
 109 (test uchar.error.5
 110   (signals type-error
 111     (uchar 'nil)))
 112 \f
 113
 114 (test ucharp.1
 115   (is-true (ucharp 0)))
 116
 117 (test ucharp.2
 118   (is-true (ucharp (1- uchar-code-limit))))
 119
 120 (test ucharp.3
 121   (is-false (ucharp -1)))
 122
 123 (test ucharp.4
 124   (is-false (ucharp uchar-code-limit)))
 125
 126 (test ucharp.5
 127   (is-false (ucharp #\a)))
 128
 129 (test ucharp.6
 130   (is-false (ucharp "string")))
 131 \f
 132
 133 (test unicode-uchar-p.1
 134   (is-true (unicode-uchar-p #xD7FF)))
 135
 136 (test unicode-uchar-p.2
 137   (is-true (unicode-uchar-p #xDE00)))
 138
 139 (test unicode-uchar-p.1
 140   (is-false (unicode-uchar-p #xD800)))
 141
 142 (test unicode-uchar-p.2
 143   (is-false (unicode-uchar-p #xDFFF)))
 144 \f
 145
 146 (test uchar=.1
 147   (is (eql t (uchar= #x40))))
 148
 149 (test uchar=.2
 150   (is (eql t (uchar= #x40 #x40))))
 151
 152 (test uchar=.3
 153   (is (eql t (uchar= #x40 #x40 #x40))))
 154
 155 (test uchar=.4
 156   (is (eql nil (uchar= #x40 #x41))))
 157 \f
 158
 159 (test uchar/=.1
 160   (is (eql t (uchar/= #x40))))
 161
 162 (test uchar/=.2
 163   (is (eql t (uchar/= #x40 #x41))))
 164
 165 (test uchar/=.3
 166   (is (eql t (uchar/= #x40 #x41 #x42))))
 167
 168 (test uchar/=.4
 169   (is (eql nil (uchar/= #x40 #x40))))
 170
 171 (test uchar/=.5
 172   (is (eql nil (uchar/= #x40 #x41 #x40))))
 173 \f
 174
 175 (test uchar<.1
 176   (is (eql t (uchar< #x40))))
 177
 178 (test uchar<.2
 179   (is (eql t (uchar< #x40 #x41))))
 180
 181 (test uchar<.3
 182   (is (eql t (uchar< #x40 #x41 #x42))))
 183
 184 (test uchar<.4
 185   (is (eql nil (uchar< #x40 #x40))))
 186
 187 (test uchar<.5
 188   (is (eql nil (uchar< #x40 #x41 #x40))))
 189 \f
 190
 191 (test uchar>.1
 192   (is (eql t (uchar> #x40))))
 193
 194 (test uchar>.2
 195   (is (eql t (uchar> #x41 #x40))))
 196
 197 (test uchar>.3
 198   (is (eql t (uchar> #x42 #x41 #x40))))
 199
 200 (test uchar>.4
 201   (is (eql nil (uchar> #x40 #x40))))
 202
 203 (test uchar>.5
 204   (is (eql nil (uchar> #x41 #x40 #x40))))
 205 \f
 206
 207 (test uchar<=.1
 208   (is (eql t (uchar<= #x40))))
 209
 210 (test uchar<=.2
 211   (is (eql t (uchar<= #x40 #x41))))
 212
 213 (test uchar<=.3
 214   (is (eql t (uchar<= #x40 #x41 #x42))))
 215
 216 (test uchar<=.4
 217   (is (eql t (uchar<= #x40 #x40))))
 218
 219 (test uchar<=.5
 220   (is (eql nil (uchar<= #x40 #x41 #x40))))
 221 \f
 222
 223 (test uchar>=.1
 224   (is (eql t (uchar>= #x40))))
 225
 226 (test uchar>=.2
 227   (is (eql t (uchar>= #x41 #x40))))
 228
 229 (test uchar>=.3
 230   (is (eql t (uchar>= #x42 #x41 #x40))))
 231
 232 (test uchar>=.4
 233   (is (eql t (uchar>= #x40 #x40))))
 234
 235 (test uchar>=.5
 236   (is (eql nil (uchar>= #x40 #x41 #x40))))
 237 \f
 238
 239 (test uchar-equal.1
 240   (is (eql t (uchar-equal #x40))))
 241
 242 (test uchar-equal.2
 243   (is (eql t (uchar-equal #x40 #x40))))
 244
 245 (test uchar-equal.3
 246   (is (eql t (uchar-equal #x40 #x40 #x40))))
 247
 248 (test uchar-equal.4
 249   (is (eql t (uchar-equal #x41 #x61))))
 250
 251 (test uchar-equal.5
 252   (is (eql t (uchar-equal #x41 #x61 #x41))))
 253
 254 (test uchar-equal.6
 255   (is (eql nil (uchar-equal #x40 #x41))))
 256 \f
 257
 258 (test uchar-not-equal.1
 259   (is (eql t (uchar-not-equal #x40))))
 260
 261 (test uchar-not-equal.2
 262   (is (eql t (uchar-not-equal #x40 #x41))))
 263
 264 (test uchar-not-equal.3
 265   (is (eql t (uchar-not-equal #x40 #x41 #x42))))
 266
 267 (test uchar-not-equal.4
 268   (is (eql nil (uchar-not-equal #x40 #x40))))
 269
 270 (test uchar-not-equal.5
 271   (is (eql nil (uchar-not-equal #x40 #x41 #x40))))
 272
 273 (test uchar-not-equal.6
 274   (is (eql nil (uchar-not-equal #x41 #x61))))
 275
 276 (test uchar-not-equal.7
 277   (is (eql nil (uchar-not-equal #x41 #x61 #x41))))
 278 \f
 279
 280 (test uchar-lessp.1
 281   (is (eql t (uchar-lessp #x40))))
 282
 283 (test uchar-lessp.2
 284   (is (eql t (uchar-lessp #x40 #x41))))
 285
 286 (test uchar-lessp.3
 287   (is (eql t (uchar-lessp #x40 #x41 #x42))))
 288
 289 (test uchar-lessp.4
 290   (is (eql nil (uchar-lessp #x40 #x40))))
 291
 292 (test uchar-lessp.5
 293   (is (eql nil (uchar-lessp #x40 #x41 #x40))))
 294
 295 (test uchar-lessp.6
 296   (is (eql nil (uchar-lessp #x41 #x61))))
 297
 298 (test uchar-lessp.7
 299   (is (eql nil (uchar-lessp #x41 #x61 #x62))))
 300 \f
 301
 302 (test uchar-greaterp.1
 303   (is (eql t (uchar-greaterp #x40))))
 304
 305 (test uchar-greaterp.2
 306   (is (eql t (uchar-greaterp #x41 #x40))))
 307
 308 (test uchar-greaterp.3
 309   (is (eql t (uchar-greaterp #x42 #x41 #x40))))
 310
 311 (test uchar-greaterp.4
 312   (is (eql nil (uchar-greaterp #x40 #x40))))
 313
 314 (test uchar-greaterp.5
 315   (is (eql nil (uchar-greaterp #x41 #x40 #x40))))
 316
 317 (test uchar-greaterp.6
 318   (is (eql nil (uchar-greaterp #x61 #x41))))
 319
 320 (test uchar-greaterp.7
 321   (is (eql nil (uchar-greaterp #x62 #x61 #x41))))
 322 \f
 323
 324 (test uchar-not-greaterp.1
 325   (is (eql t (uchar-not-greaterp #x40))))
 326
 327 (test uchar-not-greaterp.2
 328   (is (eql t (uchar-not-greaterp #x40 #x41))))
 329
 330 (test uchar-not-greaterp.3
 331   (is (eql t (uchar-not-greaterp #x40 #x41 #x42))))
 332
 333 (test uchar-not-greaterp.4
 334   (is (eql t (uchar-not-greaterp #x40 #x40))))
 335
 336 (test uchar-not-greaterp.5
 337   (is (eql nil (uchar-not-greaterp #x40 #x41 #x40))))
 338
 339 (test uchar-not-greaterp.6
 340   (is (eql t (uchar-not-greaterp #x41 #x61))))
 341
 342 (test uchar-not-greaterp.7
 343   (is (eql t (uchar-not-greaterp #x41 #x61 #x62))))
 344 \f
 345
 346 (test uchar-not-lessp.1
 347   (is (eql t (uchar-not-lessp #x40))))
 348
 349 (test uchar-not-lessp.2
 350   (is (eql t (uchar-not-lessp #x41 #x40))))
 351
 352 (test uchar-not-lessp.3
 353   (is (eql t (uchar-not-lessp #x42 #x41 #x40))))
 354
 355 (test uchar-not-lessp.4
 356   (is (eql t (uchar-not-lessp #x40 #x40))))
 357
 358 (test uchar-not-lessp.5
 359   (is (eql t (uchar-not-lessp #x61 #x41))))
 360
 361 (test uchar-not-lessp.6
 362   (is (eql t (uchar-not-lessp #x62 #x61 #x41))))
 363
 364 (test uchar-not-lessp.7
 365   (is (eql nil (uchar-not-lessp #x40 #x41 #x40))))
 366 \f
 367
 368 (test alpha-uchar-p.1
 369   (is-true
 370    (and (loop :for r :from (char-to-uchar #\a) :to (char-to-uchar #\z)
 371               :always (alpha-uchar-p r))
 372         (loop :for r :from (char-to-uchar #\A) :to (char-to-uchar #\Z)
 373               :always (alpha-uchar-p r)))))
 374
 375 (test alpha-uchar-p.2
 376   (is-false
 377    (alpha-uchar-p (char-to-uchar #\5))))
 378
 379 (test alpha-uchar-p.3
 380   (is-true
 381    (loop :for i :from 0 :to 255
 382          :always (eql (alpha-uchar-p i)
 383                       (alpha-char-p (code-char i))))))
 384
 385 (test alpha-uchar-p.error.1
 386   (signals type-error
 387    (alpha-uchar-p "string")))
 388 \f
 389
 390 (test digit-uchar-p.1
 391   (is (eql 9 (digit-uchar-p (+ #x30 9)))))
 392
 393 (test digit-uchar-p.2
 394   (is (loop :for i :below 10 :always (eql i (digit-uchar-p (+ i #x30) 10)))))
 395
 396 (test digit-uchar-p.3
 397   (is (loop :for i :from 10 :below 36
 398             :always (eql i (digit-uchar-p (+ i #x57) 36)))))
 399
 400 (test digit-uchar-p.4
 401   (is-true
 402    (loop :for i :from 0 :to 255
 403          :always (eql (digit-uchar-p i)
 404                       (digit-char-p (code-char i))))))
 405
 406 (test digit-uchar.error.1
 407   (is-false (digit-uchar-p 16 16)))
 408
 409 (test digit-uchar.error.2
 410   (signals type-error
 411     (digit-uchar-p "string")))
 412 \f
 413
 414 (test alphanumeric-uchar-p.1
 415   (is-true
 416    (loop :for i :from 0 :to 255
 417          :always (eql (alphanumeric-uchar-p i)
 418                       (alphanumericp (code-char i))))))
 419
 420 (test alphanumeric-uchar-p.error.1
 421   (signals type-error
 422     (alphanumeric-uchar-p "string")))
 423 \f
 424
 425 (test graphic-uchar-p.1
 426   (is-true
 427    (loop :for i :from 0 :to 255
 428          :always (eql (graphic-uchar-p i)
 429                       (graphic-char-p (code-char i))))))
 430
 431 (test graphic-uchar-p.error.1
 432   (signals type-error
 433     (graphic-uchar-p "string")))
 434 \f
 435
 436 (test upper-case-uchar-p.1
 437   (is-true
 438    (loop :for i :from 0 :to 255
 439          :always (eql (upper-case-uchar-p i)
 440                       (upper-case-p (code-char i))))))
 441
 442 (test upper-case-uchar-p.error.1
 443   (signals type-error
 444     (upper-case-uchar-p "string")))
 445 \f
 446
 447 (test lower-case-uchar-p.1
 448   (is-true
 449    (loop :for i :from 0 :to 255
 450          :always (eql (lower-case-uchar-p i)
 451                       (lower-case-p (code-char i))))))
 452
 453 (test lower-case-uchar-p.error.1
 454   (signals type-error
 455     (lower-case-uchar-p "string")))
 456 \f
 457
 458 (test both-case-uchar-p.1
 459   (is-true
 460    (loop :for i :from 0 :to 255
 461          :always (eql (both-case-uchar-p i)
 462                       (both-case-p (code-char i))))))
 463
 464 (test both-case-uchar-p.error.1
 465   (signals type-error
 466     (both-case-uchar-p "string")))
 467 \f
 468
 469 (test uchar-upcase.1
 470   (is-true
 471    (loop :for i :from 0 :to 255
 472          :always (eql (uchar-upcase i)
 473                       (char-to-uchar (char-upcase (code-char i)))))))
 474
 475 (test uchar-upcase.error.1
 476   (signals type-error
 477     (uchar-upcase "string")))
 478 \f
 479
 480 (test uchar-downcase.1
 481   (is-true
 482    (loop :for i :from 0 :to 255
 483          :always (eql (uchar-downcase i)
 484                       (char-to-uchar (char-downcase (code-char i)))))))
 485
 486 (test uchar-downcase.error.1
 487   (signals type-error
 488     (uchar-downcase "string")))