apropos-list.lsp 2.81 KB
Newer Older
pfdietz's avatar
pfdietz committed
1
2
3
4
5
6
7
8
9
10
11
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Dec 14 06:21:45 2004
;;;; Contains: Tests of APROPOS-LIST

(in-package :cl-test)

(deftest apropos-list.1
  (let ((pkg "CL-TEST-APROPOS-LIST-PACKAGE"))
    (safely-delete-package pkg)
    (unwind-protect
sds's avatar
sds committed
12
13
14
15
16
17
18
19
20
21
22
        (progn
          (eval `(defpackage ,pkg (:use)))
          (let* ((sym (intern "FOO" pkg)))
            (loop for p in (list pkg (find-package pkg) (make-symbol pkg))
                  nconc
                  (loop for string-designator in
                        '("F" "O" #\F #\O "" "FOO" "FO"
                          "OO" :|F| :|FO| :|FOO| :|O| :|OO|)
                        for result = (apropos-list string-designator p)
                        unless (equal result (list sym))
                        collect (list string-designator result)))))
pfdietz's avatar
pfdietz committed
23
24
25
26
27
28
29
      (safely-delete-package pkg)))
  nil)

(deftest apropos-list.2
  (let ((pkg #\A))
    (safely-delete-package pkg)
    (unwind-protect
sds's avatar
sds committed
30
31
32
33
34
35
36
37
38
        (progn
          (eval `(defpackage ,pkg (:use)))
          (let* ((sym (intern "FOO" pkg)))
            (loop for string-designator in
                  '("F" "O" #\F #\O "" "FOO" "FO"
                    "OO" :|F| :|FO| :|FOO| :|O| :|OO|)
                  for result = (apropos-list string-designator pkg)
                  unless (equal result (list sym))
                  collect (list string-designator result))))
pfdietz's avatar
pfdietz committed
39
40
41
42
43
44
45
      (safely-delete-package pkg)))
  nil)

(deftest apropos-list.3
  (let ((pkg "CL-TEST-APROPOS-LIST-PACKAGE"))
    (safely-delete-package pkg)
    (unwind-protect
sds's avatar
sds committed
46
47
48
49
        (progn
          (eval `(defpackage ,pkg (:use)))
          (intern "FOO" pkg)
          (apropos-list "X" pkg))
pfdietz's avatar
pfdietz committed
50
51
52
53
54
      (safely-delete-package pkg)))
  nil)

(deftest apropos-list.4
  (let ((sym :|X|)
sds's avatar
sds committed
55
        (symbols (apropos-list "X")))
pfdietz's avatar
pfdietz committed
56
57
58
59
60
    (notnot (member sym symbols)))
  t)

(deftest apropos-list.5
  (let ((sym :|X|)
sds's avatar
sds committed
61
        (symbols (apropos-list '#:|X|)))
pfdietz's avatar
pfdietz committed
62
63
64
65
66
    (notnot (member sym symbols)))
  t)

(deftest apropos-list.6
  (let ((sym :|X|)
sds's avatar
sds committed
67
        (symbols (apropos-list #\X)))
pfdietz's avatar
pfdietz committed
68
69
70
71
72
    (notnot (member sym symbols)))
  t)

(deftest apropos-list.7
  (let ((sym :|X|)
sds's avatar
sds committed
73
        (symbols (apropos-list "X" nil)))
pfdietz's avatar
pfdietz committed
74
75
76
    (notnot (member sym symbols)))
  t)

77
78
79
80
81
(deftest apropos-list.8
  (let ((*package* (find-package "COMMON-LISP")))
    (macrolet
     ((%m (z) z))
     (intersection '(car)
sds's avatar
sds committed
82
                   (apropos-list (expand-in-current-env (%m "CAR"))))))
83
84
85
86
87
88
  (car))

(deftest apropos-list.9
  (macrolet
   ((%m (z) z))
   (intersection '(car)
sds's avatar
sds committed
89
90
                 (apropos-list "CAR" (expand-in-current-env
                                      (%m (find-package "COMMON-LISP"))))))
91
92
  (car))

pfdietz's avatar
pfdietz committed
93
94
95
96
97
98
99
100
101
;;; Error tests

(deftest apropos-list.error.1
  (signals-error (apropos-list) program-error)
  t)

(deftest apropos-list.error.2
  (signals-error (apropos-list "X" (find-package "CL-TEST") nil) program-error)
  t)