mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
8edf1dc623
Instead of defining a separate module, given that "read" calls are quite all over the place, we're just going to replace the boot "read" binding with read.scm. This way, we'll be able to remove support for reader options in the boot reader, as it will only ever be used for a finite set of files. * NEWS: Update. * module/Makefile.am (ice-9/boot-9.go): Depend on read.scm. (SOURCES): * am/bootstrap.am (SOURCES): Don't build a ice-9/read.go, as we include it. * module/ice-9/boot-9.scm (read-syntax): Define here, as "include" now uses it. (read-hash-procedures, read-hash-procedure, read-hash-extend): New procedures. Will replace C variants. (read, read-syntax): Include read.scm to define these. * module/ice-9/psyntax-pp.scm (include): Regenerate. * module/ice-9/psyntax.scm (include): Use read-syntax, so we get better source information. * module/ice-9/read.scm (let*-values): New local definition, to avoid loading srfi-11. (%read): Use list->typed-array instead of u8-list->bytevector. * module/language/scheme/spec.scm: Remove (ice-9 read) import; read-syntax is there in the boot environment
323 lines
9 KiB
Scheme
323 lines
9 KiB
Scheme
;;;; chars.test --- Characters. -*- coding: utf-8; mode: scheme; -*-
|
|
;;;; Greg J. Badros <gjb@cs.washington.edu>
|
|
;;;;
|
|
;;;; Copyright (C) 2000, 2006, 2009, 2010, 2013, 2021 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"))
|
|
|
|
|
|
(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"
|
|
(char<? #\A #\a))
|
|
|
|
(pass-if "char<? #\\A #\\B"
|
|
(char<? #\A #\B))
|
|
|
|
(pass-if "char<? #\\B #\\A"
|
|
(not (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))
|
|
|
|
(pass-if "char<=? #\\B #\\A"
|
|
(not (char<=? #\B #\A)))
|
|
|
|
;; 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"
|
|
(char-ci<? #\A #\B))
|
|
|
|
(pass-if "char-ci<? #\\B #\\A"
|
|
(not (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))
|
|
|
|
(pass-if "char-ci<=? #\\B #\\A"
|
|
(not (char-ci<=? #\B #\A)))
|
|
|
|
;; 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
|
|
(with-input-from-string "#\\154000" read))
|
|
|
|
(pass-if-exception "octal out of range, too big"
|
|
exception:out-of-range
|
|
(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-output-to-string (lambda () (write accent)))
|
|
"#\\◌̏")))
|
|
|
|
(pass-if "combining X is pretty-printed"
|
|
(let ((x (integer->char #x0353))) ; COMBINING X BELOW
|
|
(string=?
|
|
(with-output-to-string (lambda () (write x)))
|
|
"#\\◌͓")))))
|