source: trunk/source/tests/ansi-tests/gentemp.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: 3.8 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Jun 22 09:32:09 2003
4;;;; Contains: Tests of GENTEMP
5
6(in-package :cl-test)
7
8(deftest gentemp.1
9  (let* ((package-name "GENTEMP-TEST-PACKAGE"))
10    (unwind-protect
11        (let* ((pkg (make-package package-name :use nil))
12               (gcounter *gensym-counter*)
13               (sym (let ((*package* pkg)) (gentemp)))
14               (sym-name (symbol-name sym)))
15          (values
16           (=t gcounter *gensym-counter*) ;; wasn't changed
17           (eqlt (aref sym-name 0) #\T)
18           (notnot (every #'digit-char-p (subseq sym-name 1)))
19           (eql (symbol-package sym) pkg)
20           ;; Not external
21           (do-external-symbols (s pkg t) (when (eql s sym) (return nil)))
22           ))
23      (delete-package package-name)))
24  t t t t t)
25
26(deftest gentemp.2
27  (let* ((package-name "GENTEMP-TEST-PACKAGE"))
28    (unwind-protect
29        (let* ((pkg (make-package package-name :use nil))
30               (gcounter *gensym-counter*)
31               (sym (let ((*package* pkg)) (gentemp "X")))
32               (sym-name (symbol-name sym)))
33          (values
34           (=t gcounter *gensym-counter*) ;; wasn't changed
35           (eqlt (aref sym-name 0) #\X)
36           (notnot (every #'digit-char-p (subseq sym-name 1)))
37           (eql (symbol-package sym) pkg)
38           ;; Not external
39           (do-external-symbols (s pkg t) (when (eql s sym) (return nil)))
40           ))
41      (delete-package package-name)))
42  t t t t t)
43
44(deftest gentemp.3
45  (let* ((package-name "GENTEMP-TEST-PACKAGE"))
46    (unwind-protect
47        (let* ((pkg (make-package package-name :use nil))
48               (gcounter *gensym-counter*)
49               (sym (gentemp "X" package-name))
50               (sym-name (symbol-name sym)))
51          (values
52           (=t gcounter *gensym-counter*) ;; wasn't changed
53           (eqlt (aref sym-name 0) #\X)
54           (notnot (every #'digit-char-p (subseq sym-name 1)))
55           (eql (symbol-package sym) pkg)
56           ;; Not external
57           (do-external-symbols (s pkg t) (when (eql s sym) (return nil)))
58           ))
59      (delete-package package-name)))
60  t t t t t)
61
62(deftest gentemp.4
63  (let* ((package-name "GENTEMP-TEST-PACKAGE"))
64    (unwind-protect
65        (let* ((pkg (make-package package-name :use nil))
66               (gcounter *gensym-counter*)
67               (sym (gentemp "" (make-symbol package-name)))
68               (sym-name (symbol-name sym)))
69          (values
70           (=t gcounter *gensym-counter*) ;; wasn't changed
71           (notnot (every #'digit-char-p sym-name))
72           (eql (symbol-package sym) pkg)
73           ;; Not external
74           (do-external-symbols (s pkg t) (when (eql s sym) (return nil)))
75           ))
76      (delete-package package-name)))
77  t t t t)
78
79(deftest gentemp.5
80  (let* ((package-name "Z"))
81    (safely-delete-package package-name)
82    (unwind-protect
83        (let* ((pkg (make-package package-name :use nil))
84               (gcounter *gensym-counter*)
85               (sym (gentemp "Y" #\Z))
86               (sym-name (symbol-name sym)))
87          (values
88           (=t gcounter *gensym-counter*) ;; wasn't changed
89           (eqlt (aref sym-name 0) #\Y)
90           (notnot (every #'digit-char-p (subseq sym-name 1)))
91           (eql (symbol-package sym) pkg)
92           ;; Not external
93           (do-external-symbols (s pkg t) (when (eql s sym) (return nil)))
94           ))
95      (delete-package package-name)))
96  t t t t t)
97
98(deftest gentemp.6
99  (let* ((package-name "GENTEMP-TEST-PACKAGE"))
100    (unwind-protect
101        (let* ((*package* (make-package package-name :use nil))
102               (syms (loop repeat 100 collect (gentemp))))
103          (=t (length syms) (length (remove-duplicates syms))))
104      (delete-package package-name)))
105  t)
106
107;;; Error tests
108
109(deftest gentemp.error.1
110  (loop for x in *mini-universe*
111        unless (or (stringp x)
112                   (eql (eval `(signals-type-error x ',x (gentemp x))) t))
113        collect x)
114  nil)
115
116(deftest gentemp.error.2
117  (loop for x in *mini-universe*
118        unless (or (typep x 'package)
119                   (string-designator-p x)
120                   (eql (eval `(signals-type-error x ',x (gentemp "T" x))) t))
121        collect x)
122  nil)
123
124(deftest gentemp.error.3
125  (signals-error (gentemp "" *package* nil) program-error)
126  t)
Note: See TracBrowser for help on using the repository browser.