Skip to content
Snippets Groups Projects
Commit 5023f0ed authored by pfdietz's avatar pfdietz
Browse files

Move some symbol tests off to their own files. Added tests for nicknames of...

Move some symbol tests off to their own files.  Added tests for nicknames of standardized packages.  Added test/testnot arg ordering tests for POSITION.
parent 8dd1a7b1
No related branches found
No related tags found
No related merge requests found
...@@ -991,6 +991,21 @@ ...@@ -991,6 +991,21 @@
(deftest symbol-yes-or-no-p (test-if-not-in-cl-package "yes-or-no-p") nil) (deftest symbol-yes-or-no-p (test-if-not-in-cl-package "yes-or-no-p") nil)
(deftest symbol-zerop (test-if-not-in-cl-package "zerop") nil) (deftest symbol-zerop (test-if-not-in-cl-package "zerop") nil)
;;; Standardized packages have the right names, nicknames
(deftest keyword-package-nicknames
(package-nicknames (find-package "KEYWORD"))
nil)
(deftest common-lisp-package-nicknames
(package-nicknames (find-package "COMMON-LISP"))
("CL"))
(deftest common-lisp-user-package-nicknames
(package-nicknames (find-package "COMMON-LISP-USER"))
("CL-USER"))
;;; Test there are no extra exported symbols ;;; Test there are no extra exported symbols
(deftest no-extra-symbols-exported-from-common-lisp (deftest no-extra-symbols-exported-from-common-lisp
...@@ -1025,444 +1040,6 @@ ...@@ -1025,444 +1040,6 @@
(push (list s sym 'not-constant) result))))))) (push (list s sym 'not-constant) result)))))))
nil) nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; special-operator-p
;;; See section 3.1.2.1.2.1
(defparameter +special-operators+
'(block let* return-from catch load-time-value setq eval-when
locally symbol-macrolet flet macrolet tagbody function
multiple-value-call the go multiple-value-prog1 throw if
progn unwind-protect labels progv let quote))
;;; All the symbols in +special-operators+ are special operators
(deftest special-operator-p.1
(loop for s in +special-operators+
unless (special-operator-p s)
collect s)
nil)
;;; None of the standard symbols except those in +special-operators+
;;; are special operators, unless they have a macro function
;;; (See the page for MACRO-FUNCTION)
(deftest special-operator-p.2
(let ((p (find-package "CL")))
(loop for name in *cl-symbol-names*
unless (or (member name +special-operators+ :test #'string=)
(let ((sym (find-symbol name p)))
(or (not (special-operator-p sym))
(macro-function sym))))
collect name))
nil)
(deftest special-operator-p.order.1
(let ((i 0))
(values (notnot (special-operator-p (progn (incf i) 'catch)))
i))
t 1)
(deftest special-operator-p.error.1
(classify-error (special-operator-p 1))
type-error)
(deftest special-operator-p.error.2
(classify-error (special-operator-p))
program-error)
(deftest special-operator-p.error.3
(classify-error (special-operator-p 'cons 'cons))
program-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; keywordp
(deftest keywordp.1 (keywordp 'hefalump) nil)
(deftest keywordp.2 (keywordp 17) nil)
(deftest keywordp.3 (notnot-mv (keywordp :stream)) t)
(deftest keywordp.4 (notnot-mv (keywordp ':stream)) t)
(deftest keywordp.5 (keywordp nil) nil)
(deftest keywordp.6 (notnot-mv (keywordp :nil)) t)
(deftest keywordp.7 (keywordp '(:stream)) nil)
(deftest keywordp.8 (keywordp "rest") nil)
(deftest keywordp.9 (keywordp ":rest") nil)
(deftest keywordp.10 (keywordp '&body) nil)
;;; This next test was busted. ::foo is not portable syntax
;;(deftest keywordp.11 (notnot-mv (keywordp ::foo)) t)
(deftest keywordp.12 (keywordp t) nil)
(deftest keywordp.order.1
(let ((i 0))
(values (keywordp (progn (incf i) nil)) i))
nil 1)
(deftest keywordp.error.1 (classify-error (keywordp)) program-error)
(deftest keywordp.error.2 (classify-error (keywordp :x :x)) program-error)
(deftest keywordp.error.3
(classify-error (keywordp))
program-error)
(deftest keywordp.error.4
(classify-error (keywordp nil nil))
program-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; symbol-name
(deftest symbol-name.1
(symbol-name '|ABCD|)
"ABCD")
(deftest symbol-name.2
(symbol-name '|1234abcdABCD|)
"1234abcdABCD")
(deftest symbol-name.3
(classify-error (symbol-name 1))
type-error)
(deftest symbol-name.4
(classify-error (symbol-name '(a)))
type-error)
(deftest symbol-name.5
(classify-error (symbol-name "ABCDE"))
type-error)
(deftest symbol-name.6
(classify-error (symbol-name 12913.0213))
type-error)
(deftest symbol-name.7
(symbol-name :|abcdefg|)
"abcdefg")
(deftest symbol-name.error.1
(classify-error (symbol-name))
program-error)
(deftest symbol-name.error.2
(classify-error (symbol-name 'a 'b))
program-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; make-symbol
(deftest make-symbol.1
(notnot-mv (symbolp (make-symbol "FOO")))
t)
(deftest make-symbol.2
(symbol-package (make-symbol "BAR"))
nil)
(deftest make-symbol.3
(symbol-package (make-symbol "CL::FOO"))
nil)
(deftest make-symbol.4
(symbol-package (make-symbol "CL:FOO"))
nil)
(deftest make-symbol.5
(symbol-name (make-symbol "xyz"))
"xyz")
(deftest make-symbol.6
(eqt (make-symbol "A")
(make-symbol "A"))
nil)
(deftest make-symbol.7
(boundp (make-symbol "B"))
nil)
(deftest make-symbol.8
(symbol-plist (make-symbol "C"))
nil)
(deftest make-symbol.9
(fboundp (make-symbol "D"))
nil)
(deftest make-symbol.10
(symbol-name (make-symbol ""))
"")
(deftest make-symbol.order.1
(let ((i 0))
(values
(symbol-name (make-symbol (progn (incf i) "ABC")))
i))
"ABC" 1)
(deftest make-symbol.error.1
(classify-error (make-symbol nil))
type-error)
(deftest make-symbol.error.2
(classify-error (make-symbol 'a))
type-error)
(deftest make-symbol.error.3
(classify-error (make-symbol 1))
type-error)
(deftest make-symbol.error.4
(classify-error (make-symbol -1))
type-error)
(deftest make-symbol.error.5
(classify-error (make-symbol 1.213))
type-error)
(deftest make-symbol.error.6
(classify-error (make-symbol -1312.2))
type-error)
(deftest make-symbol.error.7
(classify-error (make-symbol #\w))
type-error)
(deftest make-symbol.error.8
(classify-error (make-symbol '(a)))
type-error)
(deftest make-symbol.error.9
(classify-error (make-symbol))
program-error)
(deftest make-symbol.error.10
(classify-error (make-symbol "a" "a"))
program-error)
(deftest make-symbol.error.11
(classify-error (make-symbol '(#\a #\b #\c)))
type-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; copy-symbol
(deftest copy-symbol.1
(notnot-mv
(every
#'(lambda (x)
(let ((y (copy-symbol x)))
(and (null (symbol-plist y))
(symbolp y)
(not (boundp y))
(not (fboundp y))
(null (symbol-package y))
(string= (symbol-name x) (symbol-name y))
(symbolp (copy-symbol y))
)))
'(nil t a b |a| |123|)))
t)
(deftest copy-symbol.2
(progn
(setf (symbol-plist '|foo|) '(a b c d))
(makunbound '|foo|)
(notnot-mv
(every
#'(lambda (x)
(let ((y (copy-symbol x t)))
(and
(equal (symbol-plist y) (symbol-plist x))
(symbolp y)
(if (boundp x)
(boundp y)
(not (boundp y)))
(if (fboundp x) (fboundp y) (not (fboundp y)))
(null (symbol-package y))
(string= (symbol-name x) (symbol-name y))
)))
'(nil t a b |foo| |a| |123|))))
t)
(deftest copy-symbol.3
(progn
(setf (symbol-plist '|foo|) '(a b c d))
(setf (symbol-value '|a|) 12345)
(notnot-mv
(every
#'(lambda (x)
(let ((y (copy-symbol x t)))
(and
(eql (length (symbol-plist y))
(length (symbol-plist x)))
;; Is a list copy
(every #'eq (symbol-plist y) (symbol-plist x))
(symbolp y)
(if (boundp x)
(eqt (symbol-value x)
(symbol-value y))
(not (boundp y)))
(if (fboundp x) (fboundp y) (not (fboundp y)))
(null (symbol-package y))
(string= (symbol-name x) (symbol-name y))
(eql (length (symbol-plist x))
(length (symbol-plist y)))
)))
'(nil t a b |foo| |a| |123|))))
t)
(deftest copy-symbol.4
(eqt (copy-symbol 'a) (copy-symbol 'a))
nil)
(deftest copy-symbol.5
(let ((i 0) x y (s '#:|x|))
(let ((s2 (copy-symbol
(progn (setf x (incf i)) s)
(progn (setf y (incf i)) nil))))
(values
(symbol-name s2)
(eq s s2)
i x y)))
"x" nil 2 1 2)
(deftest copy-symbol.error.1
(classify-error (copy-symbol))
program-error)
(deftest copy-symbol.error.2
(classify-error (copy-symbol 'a t 'foo))
program-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; gensym
;;; Gensym returns unique symbols
(deftest gensym.1
(equal (gensym) (gensym))
nil)
;;; Gensym returns symbols with distinct print names
(deftest gensym.2
(string= (symbol-name (gensym))
(symbol-name (gensym)))
nil)
;;; Gensym uses the *gensym-counter* special variable,
;;; but does not increment it until after the symbol
;;; has been created.
(deftest gensym.3
(let ((*gensym-counter* 1))
(declare (special *gensym-counter*))
(symbol-name (gensym)))
#.(string '#:g1))
;;; Gensym uses the string argument instead of the default
(deftest gensym.4
(let ((*gensym-counter* 1327))
(declare (special *gensym-counter*))
(symbol-name (gensym "FOO")))
"FOO1327")
;;; The symbol returned by gensym should be unbound
(deftest gensym.5
(boundp (gensym))
nil)
;;; The symbol returned by gensym should have no function binding
(deftest gensym.6
(fboundp (gensym))
nil)
;;; The symbol returned by gensym should have no property list
(deftest gensym.7
(symbol-plist (gensym))
nil)
;;; The symbol returned by gensym should be uninterned
(deftest gensym.8
(symbol-package (gensym))
nil)
;;; *gensym-counter* is incremented by gensym
(deftest gensym.9
(let ((*gensym-counter* 12345))
(declare (special *gensym-counter*))
(gensym)
*gensym-counter*)
12346)
;;; Gensym works when *gensym-counter* is Really Big
;;; (and does not increment the counter until after creating
;;; the symbol.)
(deftest gensym.10
(let ((*gensym-counter* 1234567890123456789012345678901234567890))
(declare (special *gensym-counter*))
(symbol-name (gensym)))
#.(string '#:g1234567890123456789012345678901234567890))
;;; gensym increments Really Big values of *gensym-counter*
(deftest gensym.11
(let ((*gensym-counter* 12345678901234567890123456789012345678901234567890))
(declare (special *gensym-counter*))
(gensym)
*gensym-counter*)
12345678901234567890123456789012345678901234567891)
;;; Gensym uses an integer argument instead of the counter
(deftest gensym.12
(let ((*gensym-counter* 10))
(declare (special *gensym-counter*))
(symbol-name (gensym 123)))
#.(string '#:g123))
;;; When given an integer argument, gensym does not increment the
;;; *gensym-counter*
(deftest gensym.13
(let ((*gensym-counter* 10))
(declare (special *gensym-counter*))
(gensym 123)
*gensym-counter*)
10)
;;; Check response to erroneous arguments
;;; Note! NIL is not the same as no argument
;;; gensym should be implemented so that its only
;;; argument defaults to "G", with NIL causing an error.
(deftest gensym.error.1
(classify-error (gensym 'aaa))
type-error)
(deftest gensym.error.2
(classify-error (gensym 12.3))
type-error)
(deftest gensym.error.3
(classify-error (gensym t))
type-error)
(deftest gensym.error.4
(classify-error (gensym nil))
type-error) ;; NIL /= no argument!
(deftest gensym.error.5
(classify-error (gensym '(a)))
type-error)
(deftest gensym.error.6
(classify-error (gensym #\x))
type-error)
(deftest gensym.error.7
(classify-error (gensym 10 'foo))
program-error)
(deftest gensym.error.8
(classify-error (locally (gensym t) t))
type-error)
;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;
;;; Tests of CL package constraints from section 11.1.2.1.1 ;;; Tests of CL package constraints from section 11.1.2.1.1
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Jun 14 05:44:41 2003
;;;; Contains: Tests of COPY-SYMBOL
(in-package :cl-test)
(deftest copy-symbol.1
(notnot-mv
(every
#'(lambda (x)
(let ((y (copy-symbol x)))
(and (null (symbol-plist y))
(symbolp y)
(not (boundp y))
(not (fboundp y))
(null (symbol-package y))
(string= (symbol-name x) (symbol-name y))
(symbolp (copy-symbol y))
)))
'(nil t a b |a| |123|)))
t)
(deftest copy-symbol.2
(progn
(setf (symbol-plist '|foo|) '(a b c d))
(makunbound '|foo|)
(notnot-mv
(every
#'(lambda (x)
(let ((y (copy-symbol x t)))
(and
(equal (symbol-plist y) (symbol-plist x))
(symbolp y)
(if (boundp x)
(boundp y)
(not (boundp y)))
(if (fboundp x) (fboundp y) (not (fboundp y)))
(null (symbol-package y))
(string= (symbol-name x) (symbol-name y))
)))
'(nil t a b |foo| |a| |123|))))
t)
(deftest copy-symbol.3
(progn
(setf (symbol-plist '|foo|) '(a b c d))
(setf (symbol-value '|a|) 12345)
(notnot-mv
(every
#'(lambda (x)
(let ((y (copy-symbol x t)))
(and
(eql (length (symbol-plist y))
(length (symbol-plist x)))
;; Is a list copy
(every #'eq (symbol-plist y) (symbol-plist x))
(symbolp y)
(if (boundp x)
(eqt (symbol-value x)
(symbol-value y))
(not (boundp y)))
(if (fboundp x) (fboundp y) (not (fboundp y)))
(null (symbol-package y))
(string= (symbol-name x) (symbol-name y))
(eql (length (symbol-plist x))
(length (symbol-plist y)))
)))
'(nil t a b |foo| |a| |123|))))
t)
(deftest copy-symbol.4
(eqt (copy-symbol 'a) (copy-symbol 'a))
nil)
(deftest copy-symbol.5
(let ((i 0) x y (s '#:|x|))
(let ((s2 (copy-symbol
(progn (setf x (incf i)) s)
(progn (setf y (incf i)) nil))))
(values
(symbol-name s2)
(eq s s2)
i x y)))
"x" nil 2 1 2)
(deftest copy-symbol.error.1
(classify-error (copy-symbol))
program-error)
(deftest copy-symbol.error.2
(classify-error (copy-symbol 'a t 'foo))
program-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Jun 14 05:43:47 2003
;;;; Contains: Tests of GENSYM
(in-package :cl-test)
;;; Gensym returns unique symbols
(deftest gensym.1
(equal (gensym) (gensym))
nil)
;;; Gensym returns symbols with distinct print names
(deftest gensym.2
(string= (symbol-name (gensym))
(symbol-name (gensym)))
nil)
;;; Gensym uses the *gensym-counter* special variable,
;;; but does not increment it until after the symbol
;;; has been created.
(deftest gensym.3
(let ((*gensym-counter* 1))
(declare (special *gensym-counter*))
(symbol-name (gensym)))
#.(string '#:g1))
;;; Gensym uses the string argument instead of the default
(deftest gensym.4
(let ((*gensym-counter* 1327))
(declare (special *gensym-counter*))
(symbol-name (gensym "FOO")))
"FOO1327")
;;; The symbol returned by gensym should be unbound
(deftest gensym.5
(boundp (gensym))
nil)
;;; The symbol returned by gensym should have no function binding
(deftest gensym.6
(fboundp (gensym))
nil)
;;; The symbol returned by gensym should have no property list
(deftest gensym.7
(symbol-plist (gensym))
nil)
;;; The symbol returned by gensym should be uninterned
(deftest gensym.8
(symbol-package (gensym))
nil)
;;; *gensym-counter* is incremented by gensym
(deftest gensym.9
(let ((*gensym-counter* 12345))
(declare (special *gensym-counter*))
(gensym)
*gensym-counter*)
12346)
;;; Gensym works when *gensym-counter* is Really Big
;;; (and does not increment the counter until after creating
;;; the symbol.)
(deftest gensym.10
(let ((*gensym-counter* 1234567890123456789012345678901234567890))
(declare (special *gensym-counter*))
(symbol-name (gensym)))
#.(string '#:g1234567890123456789012345678901234567890))
;;; gensym increments Really Big values of *gensym-counter*
(deftest gensym.11
(let ((*gensym-counter* 12345678901234567890123456789012345678901234567890))
(declare (special *gensym-counter*))
(gensym)
*gensym-counter*)
12345678901234567890123456789012345678901234567891)
;;; Gensym uses an integer argument instead of the counter
(deftest gensym.12
(let ((*gensym-counter* 10))
(declare (special *gensym-counter*))
(symbol-name (gensym 123)))
#.(string '#:g123))
;;; When given an integer argument, gensym does not increment the
;;; *gensym-counter*
(deftest gensym.13
(let ((*gensym-counter* 10))
(declare (special *gensym-counter*))
(gensym 123)
*gensym-counter*)
10)
;;; Check response to erroneous arguments
;;; Note! NIL is not the same as no argument
;;; gensym should be implemented so that its only
;;; argument defaults to "G", with NIL causing an error.
(deftest gensym.error.1
(classify-error (gensym 'aaa))
type-error)
(deftest gensym.error.2
(classify-error (gensym 12.3))
type-error)
(deftest gensym.error.3
(classify-error (gensym t))
type-error)
(deftest gensym.error.4
(classify-error (gensym nil))
type-error) ;; NIL /= no argument!
(deftest gensym.error.5
(classify-error (gensym '(a)))
type-error)
(deftest gensym.error.6
(classify-error (gensym #\x))
type-error)
(deftest gensym.error.7
(classify-error (gensym 10 'foo))
program-error)
(deftest gensym.error.8
(classify-error (locally (gensym t) t))
type-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Jun 14 05:46:51 2003
;;;; Contains: Tests of KEYWORDP
(in-package :cl-test)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; keywordp
(deftest keywordp.1 (keywordp 'hefalump) nil)
(deftest keywordp.2 (keywordp 17) nil)
(deftest keywordp.3 (notnot-mv (keywordp :stream)) t)
(deftest keywordp.4 (notnot-mv (keywordp ':stream)) t)
(deftest keywordp.5 (keywordp nil) nil)
(deftest keywordp.6 (notnot-mv (keywordp :nil)) t)
(deftest keywordp.7 (keywordp '(:stream)) nil)
(deftest keywordp.8 (keywordp "rest") nil)
(deftest keywordp.9 (keywordp ":rest") nil)
(deftest keywordp.10 (keywordp '&body) nil)
;;; This next test was busted. ::foo is not portable syntax
;;(deftest keywordp.11 (notnot-mv (keywordp ::foo)) t)
(deftest keywordp.12 (keywordp t) nil)
(deftest keywordp.order.1
(let ((i 0))
(values (keywordp (progn (incf i) nil)) i))
nil 1)
(deftest keywordp.error.1 (classify-error (keywordp)) program-error)
(deftest keywordp.error.2 (classify-error (keywordp :x :x)) program-error)
(deftest keywordp.error.3
(classify-error (keywordp))
program-error)
(deftest keywordp.error.4
(classify-error (keywordp nil nil))
program-error)
...@@ -3,3 +3,11 @@ ...@@ -3,3 +3,11 @@
;; (load "cl-symbol-names.lsp") ;; moved to gclload1.lsp ;; (load "cl-symbol-names.lsp") ;; moved to gclload1.lsp
(load "cl-symbols.lsp") (load "cl-symbols.lsp")
(load "boundp.lsp") (load "boundp.lsp")
(load "copy-symbol.lsp")
(load "gensym.lsp")
(load "keywordp.lsp")
(load "make-symbol.lsp")
(load "symbol-name.lsp")
(load "special-operator-p.lsp")
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Jun 14 05:45:21 2003
;;;; Contains: Tests of MAKE-SYMBOL
(in-package :cl-test)
(deftest make-symbol.1
(notnot-mv (symbolp (make-symbol "FOO")))
t)
(deftest make-symbol.2
(symbol-package (make-symbol "BAR"))
nil)
(deftest make-symbol.3
(symbol-package (make-symbol "CL::FOO"))
nil)
(deftest make-symbol.4
(symbol-package (make-symbol "CL:FOO"))
nil)
(deftest make-symbol.5
(symbol-name (make-symbol "xyz"))
"xyz")
(deftest make-symbol.6
(eqt (make-symbol "A")
(make-symbol "A"))
nil)
(deftest make-symbol.7
(boundp (make-symbol "B"))
nil)
(deftest make-symbol.8
(symbol-plist (make-symbol "C"))
nil)
(deftest make-symbol.9
(fboundp (make-symbol "D"))
nil)
(deftest make-symbol.10
(symbol-name (make-symbol ""))
"")
(deftest make-symbol.order.1
(let ((i 0))
(values
(symbol-name (make-symbol (progn (incf i) "ABC")))
i))
"ABC" 1)
(deftest make-symbol.error.1
(classify-error (make-symbol nil))
type-error)
(deftest make-symbol.error.2
(classify-error (make-symbol 'a))
type-error)
(deftest make-symbol.error.3
(classify-error (make-symbol 1))
type-error)
(deftest make-symbol.error.4
(classify-error (make-symbol -1))
type-error)
(deftest make-symbol.error.5
(classify-error (make-symbol 1.213))
type-error)
(deftest make-symbol.error.6
(classify-error (make-symbol -1312.2))
type-error)
(deftest make-symbol.error.7
(classify-error (make-symbol #\w))
type-error)
(deftest make-symbol.error.8
(classify-error (make-symbol '(a)))
type-error)
(deftest make-symbol.error.9
(classify-error (make-symbol))
program-error)
(deftest make-symbol.error.10
(classify-error (make-symbol "a" "a"))
program-error)
(deftest make-symbol.error.11
(classify-error (make-symbol '(#\a #\b #\c)))
type-error)
...@@ -150,6 +150,14 @@ ...@@ -150,6 +150,14 @@
:start 2 :from-end t) :start 2 :from-end t)
4) 4)
(deftest position-list.29
(position 10 '(1 4 8 10 15 20) :test #'<)
4)
(deftest position-list.30
(position 10 '(1 4 8 10 15 20) :test-not #'>=)
4)
;;; Tests on vectors ;;; Tests on vectors
(deftest position-vector.1 (deftest position-vector.1
...@@ -313,6 +321,14 @@ ...@@ -313,6 +321,14 @@
:from-end t) :from-end t)
4) 4)
(deftest position-vector.32
(position 10 #(1 4 8 10 15 20) :test #'<)
4)
(deftest position-vector.33
(position 10 #(1 4 8 10 15 20) :test-not #'>=)
4)
;;; tests on bit vectors ;;; tests on bit vectors
(deftest position-bit-vector.1 (deftest position-bit-vector.1
...@@ -484,6 +500,14 @@ ...@@ -484,6 +500,14 @@
:fill-pointer 5)) :fill-pointer 5))
1) 1)
(deftest position-bit-vector.33
(position 0 #*1111000 :test #'>=)
4)
(deftest position-bit-vector.34
(position 0 #*1111000 :test-not #'<)
4)
;;; strings ;;; strings
(deftest position-string.1 (deftest position-string.1
...@@ -638,6 +662,14 @@ ...@@ -638,6 +662,14 @@
:from-end t) :from-end t)
4) 4)
(deftest position-string.29
(position #\m "adfmpz" :test #'char<)
4)
(deftest position-string.30
(position #\m "adfmpz" :test-not #'char>=)
4)
(deftest position.order.1 (deftest position.order.1
(let ((i 0) a b c d e f g) (let ((i 0) a b c d e f g)
(values (values
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Jun 14 05:51:41 2003
;;;; Contains: Tests fo SPECIAL-OPERATOR-P
(in-package :cl-test)
;;; See section 3.1.2.1.2.1
(defparameter +special-operators+
'(block let* return-from catch load-time-value setq eval-when
locally symbol-macrolet flet macrolet tagbody function
multiple-value-call the go multiple-value-prog1 throw if
progn unwind-protect labels progv let quote))
;;; All the symbols in +special-operators+ are special operators
(deftest special-operator-p.1
(loop for s in +special-operators+
unless (special-operator-p s)
collect s)
nil)
;;; None of the standard symbols except those in +special-operators+
;;; are special operators, unless they have a macro function
;;; (See the page for MACRO-FUNCTION)
(deftest special-operator-p.2
(let ((p (find-package "CL")))
(loop for name in *cl-symbol-names*
unless (or (member name +special-operators+ :test #'string=)
(let ((sym (find-symbol name p)))
(or (not (special-operator-p sym))
(macro-function sym))))
collect name))
nil)
(deftest special-operator-p.order.1
(let ((i 0))
(values (notnot (special-operator-p (progn (incf i) 'catch)))
i))
t 1)
(deftest special-operator-p.error.1
(classify-error (special-operator-p 1))
type-error)
(deftest special-operator-p.error.2
(classify-error (special-operator-p))
program-error)
(deftest special-operator-p.error.3
(classify-error (special-operator-p 'cons 'cons))
program-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Jun 14 05:45:55 2003
;;;; Contains: Tests of SYMBOL-NAME
(in-package :cl-test)
(deftest symbol-name.1
(symbol-name '|ABCD|)
"ABCD")
(deftest symbol-name.2
(symbol-name '|1234abcdABCD|)
"1234abcdABCD")
(deftest symbol-name.3
(classify-error (symbol-name 1))
type-error)
(deftest symbol-name.4
(classify-error (symbol-name '(a)))
type-error)
(deftest symbol-name.5
(classify-error (symbol-name "ABCDE"))
type-error)
(deftest symbol-name.6
(classify-error (symbol-name 12913.0213))
type-error)
(deftest symbol-name.7
(symbol-name :|abcdefg|)
"abcdefg")
(deftest symbol-name.error.1
(classify-error (symbol-name))
program-error)
(deftest symbol-name.error.2
(classify-error (symbol-name 'a 'b))
program-error)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment