gentemp.lsp 4.25 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Jun 22 09:32:09 2003
;;;; Contains: Tests of GENTEMP

(in-package :cl-test)

pfdietz's avatar
pfdietz committed
8 9 10
(deftest gentemp.1
  (let* ((package-name "GENTEMP-TEST-PACKAGE"))
    (unwind-protect
sds's avatar
sds committed
11 12 13 14 15 16 17 18 19 20 21 22
        (let* ((pkg (make-package package-name :use nil))
               (gcounter *gensym-counter*)
               (sym (let ((*package* pkg)) (gentemp)))
               (sym-name (symbol-name sym)))
          (values
           (=t gcounter *gensym-counter*) ;; wasn't changed
           (eqlt (aref sym-name 0) #\T)
           (notnot (every #'digit-char-p (subseq sym-name 1)))
           (eql (symbol-package sym) pkg)
           ;; Not external
           (do-external-symbols (s pkg t) (when (eql s sym) (return nil)))
           ))
pfdietz's avatar
pfdietz committed
23 24
      (delete-package package-name)))
  t t t t t)
25

pfdietz's avatar
pfdietz committed
26 27 28
(deftest gentemp.2
  (let* ((package-name "GENTEMP-TEST-PACKAGE"))
    (unwind-protect
sds's avatar
sds committed
29 30 31 32 33 34 35 36 37 38 39 40
        (let* ((pkg (make-package package-name :use nil))
               (gcounter *gensym-counter*)
               (sym (let ((*package* pkg)) (gentemp "X")))
               (sym-name (symbol-name sym)))
          (values
           (=t gcounter *gensym-counter*) ;; wasn't changed
           (eqlt (aref sym-name 0) #\X)
           (notnot (every #'digit-char-p (subseq sym-name 1)))
           (eql (symbol-package sym) pkg)
           ;; Not external
           (do-external-symbols (s pkg t) (when (eql s sym) (return nil)))
           ))
pfdietz's avatar
pfdietz committed
41 42 43 44 45 46
      (delete-package package-name)))
  t t t t t)

(deftest gentemp.3
  (let* ((package-name "GENTEMP-TEST-PACKAGE"))
    (unwind-protect
sds's avatar
sds committed
47 48 49 50 51 52 53 54 55 56 57 58
        (let* ((pkg (make-package package-name :use nil))
               (gcounter *gensym-counter*)
               (sym (gentemp "X" package-name))
               (sym-name (symbol-name sym)))
          (values
           (=t gcounter *gensym-counter*) ;; wasn't changed
           (eqlt (aref sym-name 0) #\X)
           (notnot (every #'digit-char-p (subseq sym-name 1)))
           (eql (symbol-package sym) pkg)
           ;; Not external
           (do-external-symbols (s pkg t) (when (eql s sym) (return nil)))
           ))
pfdietz's avatar
pfdietz committed
59 60 61 62 63 64
      (delete-package package-name)))
  t t t t t)

(deftest gentemp.4
  (let* ((package-name "GENTEMP-TEST-PACKAGE"))
    (unwind-protect
sds's avatar
sds committed
65 66 67 68 69 70 71 72 73 74 75
        (let* ((pkg (make-package package-name :use nil))
               (gcounter *gensym-counter*)
               (sym (gentemp "" (make-symbol package-name)))
               (sym-name (symbol-name sym)))
          (values
           (=t gcounter *gensym-counter*) ;; wasn't changed
           (notnot (every #'digit-char-p sym-name))
           (eql (symbol-package sym) pkg)
           ;; Not external
           (do-external-symbols (s pkg t) (when (eql s sym) (return nil)))
           ))
pfdietz's avatar
pfdietz committed
76 77 78 79 80 81 82
      (delete-package package-name)))
  t t t t)

(deftest gentemp.5
  (let* ((package-name "Z"))
    (safely-delete-package package-name)
    (unwind-protect
sds's avatar
sds committed
83 84 85 86 87 88 89 90 91 92 93 94
        (let* ((pkg (make-package package-name :use nil))
               (gcounter *gensym-counter*)
               (sym (gentemp "Y" #\Z))
               (sym-name (symbol-name sym)))
          (values
           (=t gcounter *gensym-counter*) ;; wasn't changed
           (eqlt (aref sym-name 0) #\Y)
           (notnot (every #'digit-char-p (subseq sym-name 1)))
           (eql (symbol-package sym) pkg)
           ;; Not external
           (do-external-symbols (s pkg t) (when (eql s sym) (return nil)))
           ))
pfdietz's avatar
pfdietz committed
95 96 97 98 99 100
      (delete-package package-name)))
  t t t t t)

(deftest gentemp.6
  (let* ((package-name "GENTEMP-TEST-PACKAGE"))
    (unwind-protect
sds's avatar
sds committed
101 102 103
        (let* ((*package* (make-package package-name :use nil))
               (syms (loop repeat 100 collect (gentemp))))
          (=t (length syms) (length (remove-duplicates syms))))
pfdietz's avatar
pfdietz committed
104 105 106 107 108 109 110
      (delete-package package-name)))
  t)

;;; Error tests

(deftest gentemp.error.1
  (loop for x in *mini-universe*
sds's avatar
sds committed
111 112 113
        unless (or (stringp x)
                   (eql (eval `(signals-type-error x ',x (gentemp x))) t))
        collect x)
pfdietz's avatar
pfdietz committed
114 115 116 117
  nil)

(deftest gentemp.error.2
  (loop for x in *mini-universe*
sds's avatar
sds committed
118 119 120 121
        unless (or (typep x 'package)
                   (string-designator-p x)
                   (eql (eval `(signals-type-error x ',x (gentemp "T" x))) t))
        collect x)
pfdietz's avatar
pfdietz committed
122 123 124 125 126
  nil)

(deftest gentemp.error.3
  (signals-error (gentemp "" *package* nil) program-error)
  t)