in-package.lsp 3.01 KB
Newer Older
1 2 3
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Apr 25 08:06:03 1998
4
;;;; Contains: Tests of IN-PACKAGE
5 6 7 8 9 10 11

(in-package :cl-test)
(declaim (optimize (safety 3)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; in-package

12
(deftest in-package.1
13
  (let ((*package* *package*))
14 15 16 17
    (safely-delete-package "H")
    (make-package "H" :use ())
    (let ((p2 (in-package "H")))
      (and (eqt p2 (find-package "H"))
sds's avatar
sds committed
18
           (eqt *package* p2))))
19 20
  t)

21
(deftest in-package.2
22
  (let ((*package* *package*))
23 24 25 26
    (safely-delete-package "H")
    (make-package "H" :use ())
    (let ((p2 (in-package |H|)))
      (and (eqt p2 (find-package "H"))
sds's avatar
sds committed
27
           (eqt *package* p2))))
28 29
  t)

30
(deftest in-package.3
31
  (let ((*package* *package*))
32 33 34 35
    (safely-delete-package "H")
    (make-package "H" :use ())
    (let ((p2 (in-package :|H|)))
      (and (eqt p2 (find-package "H"))
sds's avatar
sds committed
36
           (eqt *package* p2))))
37 38
  t)

39
(deftest in-package.4
40
  (let ((*package* *package*))
41 42 43 44
    (safely-delete-package "H")
    (make-package "H" :use ())
    (let ((p2 (in-package #\H)))
      (and (eqt p2 (find-package "H"))
sds's avatar
sds committed
45
           (eqt *package* p2))))
46 47
  t)

48
(deftest in-package.5
49
  (let ((*package* *package*))
50
    (safely-delete-package "H")
51 52 53 54
    (handler-case
     (eval '(in-package "H"))
     (package-error () 'package-error)
     (error (c) c)))
55
  package-error)
56 57 58

(def-macro-test in-package.error.1
  (in-package :cl-test))
59 60 61 62 63 64

(defmacro def-in-package-test (test-name name-form)
  `(deftest ,test-name
     (let ((name ,name-form))
       (safely-delete-package name)
       (prog1
sds's avatar
sds committed
65 66 67 68 69 70
           (let* ((p (make-package name :use nil))
                  (*package* *package*)
                  (p2 (eval `(in-package ,name))))
             (list (eqt p p2)
                   (eqt p *package*)))
         (safely-delete-package name)))
71 72 73 74 75 76 77
     (t t)))

(def-in-package-test in-package.7
  (make-array 5 :initial-contents "TEST1" :element-type 'base-char))

(def-in-package-test in-package.8
  (make-array 10 :initial-contents "TEST1ABCDE"
sds's avatar
sds committed
78
              :fill-pointer 5 :element-type 'base-char))
79 80 81

(def-in-package-test in-package.9
  (make-array 10 :initial-contents "TEST1ABCDE"
sds's avatar
sds committed
82
              :fill-pointer 5 :element-type 'character))
83 84 85

(def-in-package-test in-package.10
  (make-array 5 :initial-contents "TEST1"
sds's avatar
sds committed
86
              :adjustable t :element-type 'base-char))
87 88 89

(def-in-package-test in-package.11
  (make-array 5 :initial-contents "TEST1"
sds's avatar
sds committed
90
              :adjustable t :element-type 'character))
91 92 93

(def-in-package-test in-package.12
  (let* ((etype 'base-char)
sds's avatar
sds committed
94 95
         (name0 (make-array 10 :element-type etype
                            :initial-contents "xxxxxTEST1")))
96
    (make-array 5 :element-type etype
sds's avatar
sds committed
97 98
                :displaced-to name0
                :displaced-index-offset 5)))
99 100 101

(def-in-package-test in-package.13
  (let* ((etype 'character)
sds's avatar
sds committed
102 103
         (name0 (make-array 10 :element-type etype
                            :initial-contents "xxxxxTEST1")))
104
    (make-array 5 :element-type etype
sds's avatar
sds committed
105 106
                :displaced-to name0
                :displaced-index-offset 5)))