;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Aug 29 17:14:03 2004
;;;; Contains: Tests of NAME-CHAR





(deftest name-char.1
  (name-char.1.body)
  ())

(deftest name-char.2
  (loop for s in '("RubOut" "PAGe" "BacKspace" "RetUrn" "Tab" "LineFeed"
                   "SpaCE" "NewLine")
        unless
        (let ((c1 (name-char (string-upcase s)))
              (c2 (name-char (string-downcase s)))
              (c3 (name-char (string-capitalize s)))
              (c4 (name-char s)))
          (and (eqlt c1 c2) (eqlt c2 c3) (eqlt c3 c4)))
        collect s)
  ())

(deftest name-char.order.1
  (let ((i 0))
    (values
     (name-char (progn (incf i) "Space"))
     i))
  #\Space 1)

;;; Specialized sequence tests

(deftest name-char.specialized.1
  (loop for etype in '(standard-char base-char character)
        append
        (loop for s in '("Rubout" "Page" "Backspace" "Return" "Tab" "Linefeed"
                         "Space" "Newline")
              for s2 = (make-array (length s) :element-type 'base-char
                                   :initial-contents s)
              unless (eql (name-char s) (name-char s2))
              collect (list s s2)))
  nil)

(deftest name-char.specialized.2
  (loop for etype in '(standard-char base-char character)
        append
        (loop for s in '("Rubout" "Page" "Backspace" "Return" "Tab" "Linefeed"
                         "Space" "Newline")
              for s2 = (make-array (length s) :element-type etype
                                   :adjustable t
                                   :initial-contents s)
              unless (eql (name-char s) (name-char s2))
              collect (list etype s s2)))
  nil)

(deftest name-char.specialized.3
  (loop for etype in '(standard-char base-char character)
        append
        (loop for s in '("Rubout" "Page" "Backspace" "Return" "Tab" "Linefeed"
                         "Space" "Newline")
              for s2 = (make-array (+ 3 (length s)) :element-type etype
                                   :fill-pointer (length s)
                                   :initial-contents (concatenate 'string s "   "))
              unless (eql (name-char s) (name-char s2))
              collect (list etype s s2)))
  nil)

(deftest name-char.specialized.4
  (loop for etype in '(standard-char base-char character)
        append
        (loop for s in '("Rubout" "Page" "Backspace" "Return" "Tab" "Linefeed"
                         "Space" "Newline")
              for s1 = (make-array (+ 4 (length s)) :element-type etype
                                   :initial-contents (concatenate 'string "  " s "  "))
              for s2 = (make-array (length s) :element-type etype
                                   :displaced-to s1 :displaced-index-offset 2)
              unless (eql (name-char s) (name-char s2))
              collect (list etype s s2)))
  nil)

;;; Error tests

(deftest name-char.error.1
  (signals-error (name-char) program-error)
  t)

(deftest name-char.error.2
  (signals-error (name-char "space" "space") program-error)
  t)