diff --git a/test-suite/tests/chars.test b/test-suite/tests/chars.test index b52b384c5..a8aaa58b0 100644 --- a/test-suite/tests/chars.test +++ b/test-suite/tests/chars.test @@ -1,7 +1,7 @@ ;;;; chars.test --- test suite for Guile's char functions -*- scheme -*- ;;;; Greg J. Badros ;;;; -;;;; Copyright (C) 2000, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 2000, 2006, 2009 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 @@ -31,13 +31,228 @@ ;; evaluator-internal instruction codes and characters. (pass-if-exception "evaluating chars" exception:wrong-type-to-apply - (eval '(#\0) (interaction-environment))))) + (eval '(#\0) (interaction-environment)))) -(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)))) + (with-test-prefix "comparisons" + ;; char=? + (pass-if "char=? #\\A #\\A" + (char=? #\A #\A)) + + (expect-fail "char=? #\\A #\\a" + (char=? #\A #\a)) + + (expect-fail "char=? #\\A #\\B" + (char=? #\A #\B)) + + (expect-fail "char=? #\\B #\\A" + (char=? #\A #\B)) + + ;; char? + (expect-fail "char>? #\\A #\\A" + (char>? #\A #\A)) + + (expect-fail "char>? #\\A #\\a" + (char>? #\A #\a)) + + (expect-fail "char>? #\\A #\\B" + (char>? #\A #\B)) + + (pass-if "char>? #\\B #\\A" + (char>? #\B #\A)) + + ;; char>=? + (pass-if "char>=? #\\A #\\A" + (char>=? #\A #\A)) + + (expect-fail "char>=? #\\A #\\a" + (char>=? #\A #\a)) + + (expect-fail "char>=? #\\A #\\B" + (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)) + + (expect-fail "char-ci=? #\\A #\\B" + (char-ci=? #\A #\B)) + + (expect-fail "char-ci=? #\\B #\\A" + (char-ci=? #\A #\B)) + + ;; char-ci? + (expect-fail "char-ci>? #\\A #\\A" + (char-ci>? #\A #\A)) + + (expect-fail "char-ci>? #\\A #\\a" + (char-ci>? #\A #\a)) + + (expect-fail "char-ci>? #\\A #\\B" + (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)) + + (expect-fail "char-ci>=? #\\A #\\B" + (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))))) + + (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, 0x110000" exception:out-of-range + (integer->char #x110000))) + + (with-test-prefix "case" + + (pass-if "char-upcase" + (eqv? (char-upcase #\a) #\A)) + + (pass-if "char-downcase" + (eqv? (char-downcase #\A) #\a))) + + (with-test-prefix "charnames" + + (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))))