;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Jun 22 09:32:09 2003
;;;; Contains: Tests of GENTEMP

(in-package :cl-test)

(deftest gentemp.1
  (let* ((package-name "GENTEMP-TEST-PACKAGE"))
    (unwind-protect
        (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)))
           ))
      (delete-package package-name)))
  t t t t t)

(deftest gentemp.2
  (let* ((package-name "GENTEMP-TEST-PACKAGE"))
    (unwind-protect
        (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)))
           ))
      (delete-package package-name)))
  t t t t t)

(deftest gentemp.3
  (let* ((package-name "GENTEMP-TEST-PACKAGE"))
    (unwind-protect
        (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)))
           ))
      (delete-package package-name)))
  t t t t t)

(deftest gentemp.4
  (let* ((package-name "GENTEMP-TEST-PACKAGE"))
    (unwind-protect
        (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)))
           ))
      (delete-package package-name)))
  t t t t)

(deftest gentemp.5
  (let* ((package-name "Z"))
    (safely-delete-package package-name)
    (unwind-protect
        (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)))
           ))
      (delete-package package-name)))
  t t t t t)

(deftest gentemp.6
  (let* ((package-name "GENTEMP-TEST-PACKAGE"))
    (unwind-protect
        (let* ((*package* (make-package package-name :use nil))
               (syms (loop repeat 100 collect (gentemp))))
          (=t (length syms) (length (remove-duplicates syms))))
      (delete-package package-name)))
  t)

;;; Error tests

(deftest gentemp.error.1
  (loop for x in *mini-universe*
        unless (or (stringp x)
                   (eql (eval `(signals-type-error x ',x (gentemp x))) t))
        collect x)
  nil)

(deftest gentemp.error.2
  (loop for x in *mini-universe*
        unless (or (typep x 'package)
                   (string-designator-p x)
                   (eql (eval `(signals-type-error x ',x (gentemp "T" x))) t))
        collect x)
  nil)

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