;;;; chars.test --- Characters. -*- coding: utf-8; mode: scheme; -*- ;;;; Greg J. Badros ;;;; ;;;; Copyright (C) 2000, 2006, 2009, 2010 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 (use-modules (test-suite lib)) (define exception:wrong-type-to-apply (cons 'misc-error "^Wrong type to apply:")) (define exception:unknown-character-name (cons #t "unknown character")) (define exception:out-of-range-octal (cons #t "out-of-range")) (with-test-prefix "basic char handling" (with-test-prefix "evaluator" ;; The following test makes sure that the evaluator distinguishes between ;; evaluator-internal instruction codes and characters. (pass-if-exception "evaluating chars" exception:wrong-type-arg (eval '(#\0) (interaction-environment)))) (with-test-prefix "comparisons" ;; char=? (pass-if "char=? #\\A #\\A" (char=? #\A #\A)) (pass-if "char=? #\\A #\\a" (not (char=? #\A #\a))) (pass-if "char=? #\\A #\\B" (not (char=? #\A #\B))) (pass-if "char=? #\\B #\\A" (not (char=? #\A #\B))) ;; char? (pass-if "char>? #\\A #\\A" (not (char>? #\A #\A))) (pass-if "char>? #\\A #\\a" (not (char>? #\A #\a))) (pass-if "char>? #\\A #\\B" (not (char>? #\A #\B))) (pass-if "char>? #\\B #\\A" (char>? #\B #\A)) ;; char>=? (pass-if "char>=? #\\A #\\A" (char>=? #\A #\A)) (pass-if "char>=? #\\A #\\a" (not (char>=? #\A #\a))) (pass-if "char>=? #\\A #\\B" (not (char>=? #\A #\B))) (pass-if "char>=? #\\B #\\A" (char>=? #\B #\A)) ;; char-ci=? (pass-if "char-ci=? #\\A #\\A" (char-ci=? #\A #\A)) (pass-if "char-ci=? #\\A #\\a" (char-ci=? #\A #\a)) (pass-if "char-ci=? #\\A #\\B" (not (char-ci=? #\A #\B))) (pass-if "char-ci=? #\\B #\\A" (not (char-ci=? #\A #\B))) ;; char-ci? (pass-if "char-ci>? #\\A #\\A" (not (char-ci>? #\A #\A))) (pass-if "char-ci>? #\\A #\\a" (not (char-ci>? #\A #\a))) (pass-if "char-ci>? #\\A #\\B" (not (char-ci>? #\A #\B))) (pass-if "char-ci>? #\\B #\\A" (char-ci>? #\B #\A)) ;; char-ci>=? (pass-if "char-ci>=? #\\A #\\A" (char-ci>=? #\A #\A)) (pass-if "char-ci>=? #\\A #\\a" (char-ci>=? #\A #\a)) (pass-if "char-ci>=? #\\A #\\B" (not (char-ci>=? #\A #\B))) (pass-if "char-ci>=? #\\B #\\A" (char-ci>=? #\B #\A))) (with-test-prefix "categories" (pass-if "char-alphabetic?" (and (char-alphabetic? #\a) (char-alphabetic? #\A) (not (char-alphabetic? #\1)) (not (char-alphabetic? #\+)))) (pass-if "char-numeric?" (and (not (char-numeric? #\a)) (not (char-numeric? #\A)) (char-numeric? #\1) (not (char-numeric? #\+)))) (pass-if "char-whitespace?" (and (not (char-whitespace? #\a)) (not (char-whitespace? #\A)) (not (char-whitespace? #\1)) (char-whitespace? #\space) (not (char-whitespace? #\+)))) (pass-if "char-upper-case?" (and (not (char-upper-case? #\a)) (char-upper-case? #\A) (not (char-upper-case? #\1)) (not (char-upper-case? #\+)))) (pass-if "char-lower-case?" (and (char-lower-case? #\a) (not (char-lower-case? #\A)) (not (char-lower-case? #\1)) (not (char-lower-case? #\+)))) (pass-if "char-is-both? works" (and (not (char-is-both? #\?)) (not (char-is-both? #\newline)) (char-is-both? #\a) (char-is-both? #\Z) (not (char-is-both? #\1)))) (pass-if "char-general-category" (and (eq? (char-general-category #\a) 'Ll) (eq? (char-general-category #\A) 'Lu) (eq? (char-general-category #\762) 'Lt)))) (with-test-prefix "integer" (pass-if "char->integer" (eqv? (char->integer #\A) 65)) (pass-if "integer->char" (eqv? (integer->char 65) #\A)) (pass-if-exception "integer->char out of range, -1" exception:out-of-range (integer->char -1)) (pass-if-exception "integer->char out of range, surrrogate" exception:out-of-range (integer->char #xd800)) (pass-if-exception "integer->char out of range, too big" exception:out-of-range (integer->char #x110000)) (pass-if-exception "octal out of range, surrrogate" exception:out-of-range-octal (with-input-from-string "#\\154000" read)) (pass-if-exception "octal out of range, too big" exception:out-of-range-octal (with-input-from-string "#\\4200000" read))) (with-test-prefix "case" (pass-if "char-upcase" (eqv? (char-upcase #\a) #\A)) (pass-if "char-downcase" (eqv? (char-downcase #\A) #\a)) (pass-if "char-titlecase" (and (eqv? (char-titlecase #\a) #\A) (eqv? (char-titlecase #\763) #\762)))) (with-test-prefix "charnames" (pass-if "R5RS character names" (and (eqv? #\space (integer->char #x20)) (eqv? #\newline (integer->char #x0A)))) (pass-if "R6RS character names" (and (eqv? #\nul (integer->char #x00)) (eqv? #\alarm (integer->char #x07)) (eqv? #\backspace (integer->char #x08)) (eqv? #\tab (integer->char #x09)) (eqv? #\linefeed (integer->char #x0A)) (eqv? #\newline (integer->char #x0A)) (eqv? #\vtab (integer->char #x0B)) (eqv? #\page (integer->char #x0C)) (eqv? #\return (integer->char #x0D)) (eqv? #\esc (integer->char #x1B)) (eqv? #\space (integer->char #x20)) (eqv? #\delete (integer->char #x7F)))) (pass-if "R5RS character names are case insensitive" (and (eqv? #\space #\ ) (eqv? #\SPACE #\ ) (eqv? #\Space #\ ) (eqv? #\newline (integer->char 10)) (eqv? #\NEWLINE (integer->char 10)) (eqv? #\Newline (integer->char 10)))) (pass-if "C0 control names are case insensitive" (and (eqv? #\nul #\000) (eqv? #\soh #\001) (eqv? #\stx #\002) (eqv? #\NUL #\000) (eqv? #\SOH #\001) (eqv? #\STX #\002) (eqv? #\Nul #\000) (eqv? #\Soh #\001) (eqv? #\Stx #\002))) (pass-if "alt charnames are case insensitive" (eqv? #\null #\nul) (eqv? #\NULL #\nul) (eqv? #\Null #\nul)) (pass-if-exception "bad charname" exception:unknown-character-name (with-input-from-string "#\\blammo" read)) (pass-if "R5RS character names are preferred write format" (string=? (with-output-to-string (lambda () (write #\space))) "#\\space")) (pass-if "C0 control character names are preferred write format" (string=? (with-output-to-string (lambda () (write #\soh))) "#\\soh")) (pass-if "combining accent is pretty-printed" (let ((accent (integer->char #x030f))) ; COMBINING DOUBLE GRAVE ACCENT (string=? (with-fluids ((%default-port-encoding "UTF-8")) (with-output-to-string (lambda () (write accent)))) "#\\◌̏"))) (pass-if "combining X is pretty-printed" (let ((x (integer->char #x0353))) ; COMBINING X BELOW (string=? (with-fluids ((%default-port-encoding "UTF-8")) (with-output-to-string (lambda () (write x)))) "#\\◌͓")))))