mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 21:10:27 +02:00
Code Activity

More tests for chars.test

Browse source 
* test-suite/tests/chars.test: more tests
This commit is contained in:
Michael Gran 2009-08-28 23:48:36 -07:00
parent 24d23822ee
commit 1893df4145
1 changed files with 224 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

221
test-suite/tests/chars.test
View file

@ -1,7 +1,7 @@
;;;; chars.test --- test suite for Guile's char functions -*- scheme -*-
;;;; Greg J. Badros <gjb@cs.washington.edu>
;;;;
;;;; 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,7 +31,172 @@
;; evaluator-internal instruction codes and characters.
(pass-if-exception "evaluating chars"
exception:wrong-type-to-apply
(eval '(#\0) (interaction-environment)))))
(eval '(#\0) (interaction-environment))))
(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))
(pass-if "char<? #\\A #\\a"
(char<? #\A #\a))
(pass-if "char<? #\\A #\\B"
(char<? #\A #\B))
(expect-fail "char<? #\\B #\\A"
(char<? #\B #\A))
;; char<=?
(pass-if "char<=? #\\A #\\A"
(char<=? #\A #\A))
(pass-if "char<=? #\\A #\\a"
(char<=? #\A #\a))
(pass-if "char<=? #\\A #\\B"
(char<=? #\A #\B))
(expect-fail "char<=? #\\B #\\A"
(char<=? #\B #\A))
;; 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))
(pass-if "char-ci<? #\\A #\\B"
(char-ci<? #\A #\B))
(expect-fail "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"
(char-ci<=? #\A #\B))
(expect-fail "char-ci<=? #\\B #\\A"
(char-ci<=? #\B #\A))
;; 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
@ -39,5 +204,55 @@
(not (char-is-both? #\newline))
(char-is-both? #\a)
(char-is-both? #\Z)
(not (char-is-both? #\1))))
(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))))