source: trunk/source/tests/ansi-tests/name-char.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 2.6 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Aug 29 17:14:03 2004
4;;;; Contains: Tests of NAME-CHAR
5
6(in-package :cl-test)
7
8(compile-and-load "char-aux.lsp")
9
10(deftest name-char.1
11  (name-char.1.body)
12  t)
13
14(deftest name-char.2
15  (loop for s in '("RubOut" "PAGe" "BacKspace" "RetUrn" "Tab" "LineFeed"
16                   "SpaCE" "NewLine")
17        always
18        (let ((c1 (name-char (string-upcase s)))
19              (c2 (name-char (string-downcase s)))
20              (c3 (name-char (string-capitalize s)))
21              (c4 (name-char s)))
22          (and (eqlt c1 c2) (eqlt c2 c3) (eqlt c3 c4))))
23  t)
24
25(deftest name-char.order.1
26  (let ((i 0))
27    (values
28     (name-char (progn (incf i) "Space"))
29     i))
30  #\Space 1)
31
32;;; Specialized sequence tests
33
34(deftest name-char.specialized.1
35  (loop for etype in '(standard-char base-char character)
36        append
37        (loop for s in '("Rubout" "Page" "Backspace" "Return" "Tab" "Linefeed"
38                         "Space" "Newline")
39              for s2 = (make-array (length s) :element-type 'base-char
40                                   :initial-contents s)
41              unless (eql (name-char s) (name-char s2))
42              collect (list s s2)))
43  nil)
44
45(deftest name-char.specialized.2
46  (loop for etype in '(standard-char base-char character)
47        append
48        (loop for s in '("Rubout" "Page" "Backspace" "Return" "Tab" "Linefeed"
49                         "Space" "Newline")
50              for s2 = (make-array (length s) :element-type etype
51                                   :adjustable t
52                                   :initial-contents s)
53              unless (eql (name-char s) (name-char s2))
54              collect (list etype s s2)))
55  nil)
56
57(deftest name-char.specialized.3
58  (loop for etype in '(standard-char base-char character)
59        append
60        (loop for s in '("Rubout" "Page" "Backspace" "Return" "Tab" "Linefeed"
61                         "Space" "Newline")
62              for s2 = (make-array (+ 3 (length s)) :element-type etype
63                                   :fill-pointer (length s)
64                                   :initial-contents (concatenate 'string s "   "))
65              unless (eql (name-char s) (name-char s2))
66              collect (list etype s s2)))
67  nil)
68
69(deftest name-char.specialized.4
70  (loop for etype in '(standard-char base-char character)
71        append
72        (loop for s in '("Rubout" "Page" "Backspace" "Return" "Tab" "Linefeed"
73                         "Space" "Newline")
74              for s1 = (make-array (+ 4 (length s)) :element-type etype
75                                   :initial-contents (concatenate 'string "  " s "  "))
76              for s2 = (make-array (length s) :element-type etype
77                                   :displaced-to s1 :displaced-index-offset 2)
78              unless (eql (name-char s) (name-char s2))
79              collect (list etype s s2)))
80  nil)
81
82;;; Error tests
83
84(deftest name-char.error.1
85  (signals-error (name-char) program-error)
86  t)
87
88(deftest name-char.error.2
89  (signals-error (name-char "space" "space") program-error)
90  t)
Note: See TracBrowser for help on using the repository browser.