|
|
1
|
+;;; Tests for deftype documention and location info
|
|
|
2
|
+
|
|
|
3
|
+(defpackage :deftype-tests
|
|
|
4
|
+ (:use :cl :lisp-unit))
|
|
|
5
|
+
|
|
|
6
|
+(in-package "DEFTYPE-TESTS")
|
|
|
7
|
+
|
|
|
8
|
+(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
|
9
|
+ ;; Capture the package.
|
|
|
10
|
+ (defvar *test-package* *package*))
|
|
|
11
|
+
|
|
|
12
|
+;; Various types for testing.
|
|
|
13
|
+(deftype issue.495.no-args ()
|
|
|
14
|
+ '(integer 0 10))
|
|
|
15
|
+
|
|
|
16
|
+(deftype issue.495.optional (&optional low high)
|
|
|
17
|
+ `(float ,low ,high))
|
|
|
18
|
+
|
|
|
19
|
+(deftype issue.495.required (low high)
|
|
|
20
|
+ `(integer ,low ,high))
|
|
|
21
|
+
|
|
|
22
|
+(deftype issue.495.with-doc ()
|
|
|
23
|
+ "A small non-negative integer."
|
|
|
24
|
+ '(integer 0 10))
|
|
|
25
|
+
|
|
|
26
|
+(define-test issue.495.lambda-list
|
|
|
27
|
+ (:tag :issues)
|
|
|
28
|
+ ;; lambda-list should be empty
|
|
|
29
|
+ (assert-false (c::info :type :lambda-list 'issue.495.no-args))
|
|
|
30
|
+ ;; lambda-list should match
|
|
|
31
|
+ (assert-equal '(&optional low high)
|
|
|
32
|
+ (c::info :type :lambda-list 'issue.495.optional))
|
|
|
33
|
+ (assert-equal '(low high)
|
|
|
34
|
+ (c::info :type :lambda-list 'issue.495.required)))
|
|
|
35
|
+
|
|
|
36
|
+(define-test issue.495.doc
|
|
|
37
|
+ (:tag :issues)
|
|
|
38
|
+ ;; Test that the docstring is returned as expected.
|
|
|
39
|
+ (assert-equal "A small non-negative integer."
|
|
|
40
|
+ (documentation 'issue.495.with-doc 'type))
|
|
|
41
|
+ (assert-equal "A small non-negative integer."
|
|
|
42
|
+ (c::info :type :documentation 'issue.495.with-doc)))
|
|
|
43
|
+
|
|
|
44
|
+(define-test issue.495.expander
|
|
|
45
|
+ (:tag :issues)
|
|
|
46
|
+ ;; Test that the type expander produces the expected output.
|
|
|
47
|
+ (assert-equal '(integer 0 10)
|
|
|
48
|
+ (funcall (c::info :type :expander 'issue.495.no-args)
|
|
|
49
|
+ '(issue.495.no-args)))
|
|
|
50
|
+ (assert-equal '(float * *)
|
|
|
51
|
+ (funcall (c::info :type :expander 'issue.495.optional)
|
|
|
52
|
+ '(issue.495.optional))))
|
|
|
53
|
+
|
|
|
54
|
+(define-test issue.495.describe
|
|
|
55
|
+ (:tag :issues)
|
|
|
56
|
+ ;; Just make sure describe prints some string. We're not testing
|
|
|
57
|
+ ;; the contents of the string.
|
|
|
58
|
+ (assert-true
|
|
|
59
|
+ (stringp (with-output-to-string (*standard-output*)
|
|
|
60
|
+ (describe 'issue.495.no-args))))
|
|
|
61
|
+ (assert-true
|
|
|
62
|
+ (stringp (with-output-to-string (*standard-output*)
|
|
|
63
|
+ (describe 'issue.495.optional))))
|
|
|
64
|
+ (assert-true
|
|
|
65
|
+ (stringp (with-output-to-string (*standard-output*)
|
|
|
66
|
+ (describe 'issue.495.required)))))
|
|
|
67
|
+
|
|
|
68
|
+(define-test issue.495.source-location
|
|
|
69
|
+ (:tag :issues)
|
|
|
70
|
+ ;; The source-location info is non-NIL only if we compile the
|
|
|
71
|
+ ;; deftype form.
|
|
|
72
|
+ ;;
|
|
|
73
|
+ ;; Create a temp file that contains the deftype. Compile it and
|
|
|
74
|
+ ;; load it into this lisp.
|
|
|
75
|
+ (ext:with-temporary-file (temp-file)
|
|
|
76
|
+ (with-open-file (s temp-file
|
|
|
77
|
+ :direction :io
|
|
|
78
|
+ :if-exists :supersede
|
|
|
79
|
+ :element-type 'character)
|
|
|
80
|
+ (format s "(in-package ~A)~%" (package-name *test-package*))
|
|
|
81
|
+ (format s "(deftype issue.495.locn () 'integer)")
|
|
|
82
|
+ (file-position s 0)
|
|
|
83
|
+ (ext:compile-from-stream s)))
|
|
|
84
|
+ ;; The source-location should be stored only in the :deftype, not
|
|
|
85
|
+ ;; :defvar.
|
|
|
86
|
+ (assert-true (c::info :source-location :deftype 'issue.495.locn))
|
|
|
87
|
+ (assert-false (c::info :source-location :defvar 'issue.495.locn))) |