From 5023f0ed5af50dde413fa1274c9d131e5acac701 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sat, 14 Jun 2003 10:57:44 +0000 Subject: [PATCH] Move some symbol tests off to their own files. Added tests for nicknames of standardized packages. Added test/testnot arg ordering tests for POSITION. --- ansi-tests/cl-symbols.lsp | 453 +----------------------------- ansi-tests/copy-symbol.lsp | 93 ++++++ ansi-tests/gensym.lsp | 131 +++++++++ ansi-tests/keywordp.lsp | 41 +++ ansi-tests/load-symbols.lsp | 8 + ansi-tests/make-symbol.lsp | 98 +++++++ ansi-tests/position.lsp | 32 +++ ansi-tests/special-operator-p.lsp | 54 ++++ ansi-tests/symbol-name.lsp | 43 +++ 9 files changed, 515 insertions(+), 438 deletions(-) create mode 100644 ansi-tests/copy-symbol.lsp create mode 100644 ansi-tests/gensym.lsp create mode 100644 ansi-tests/keywordp.lsp create mode 100644 ansi-tests/make-symbol.lsp create mode 100644 ansi-tests/special-operator-p.lsp create mode 100644 ansi-tests/symbol-name.lsp diff --git a/ansi-tests/cl-symbols.lsp b/ansi-tests/cl-symbols.lsp index d526bea0..e0287fcf 100644 --- a/ansi-tests/cl-symbols.lsp +++ b/ansi-tests/cl-symbols.lsp @@ -991,6 +991,21 @@ (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) +;;; 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 (deftest no-extra-symbols-exported-from-common-lisp @@ -1025,444 +1040,6 @@ (push (list s sym 'not-constant) result))))))) 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 diff --git a/ansi-tests/copy-symbol.lsp b/ansi-tests/copy-symbol.lsp new file mode 100644 index 00000000..c37050c0 --- /dev/null +++ b/ansi-tests/copy-symbol.lsp @@ -0,0 +1,93 @@ +;-*- 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) diff --git a/ansi-tests/gensym.lsp b/ansi-tests/gensym.lsp new file mode 100644 index 00000000..6d4e6684 --- /dev/null +++ b/ansi-tests/gensym.lsp @@ -0,0 +1,131 @@ +;-*- 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) diff --git a/ansi-tests/keywordp.lsp b/ansi-tests/keywordp.lsp new file mode 100644 index 00000000..82713851 --- /dev/null +++ b/ansi-tests/keywordp.lsp @@ -0,0 +1,41 @@ +;-*- 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) + diff --git a/ansi-tests/load-symbols.lsp b/ansi-tests/load-symbols.lsp index a74ccc63..b56019c6 100644 --- a/ansi-tests/load-symbols.lsp +++ b/ansi-tests/load-symbols.lsp @@ -3,3 +3,11 @@ ;; (load "cl-symbol-names.lsp") ;; moved to gclload1.lsp (load "cl-symbols.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") + + diff --git a/ansi-tests/make-symbol.lsp b/ansi-tests/make-symbol.lsp new file mode 100644 index 00000000..f2aa1936 --- /dev/null +++ b/ansi-tests/make-symbol.lsp @@ -0,0 +1,98 @@ +;-*- 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) diff --git a/ansi-tests/position.lsp b/ansi-tests/position.lsp index e070b909..f512d645 100644 --- a/ansi-tests/position.lsp +++ b/ansi-tests/position.lsp @@ -150,6 +150,14 @@ :start 2 :from-end t) 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 (deftest position-vector.1 @@ -313,6 +321,14 @@ :from-end t) 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 (deftest position-bit-vector.1 @@ -484,6 +500,14 @@ :fill-pointer 5)) 1) +(deftest position-bit-vector.33 + (position 0 #*1111000 :test #'>=) + 4) + +(deftest position-bit-vector.34 + (position 0 #*1111000 :test-not #'<) + 4) + ;;; strings (deftest position-string.1 @@ -638,6 +662,14 @@ :from-end t) 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 (let ((i 0) a b c d e f g) (values diff --git a/ansi-tests/special-operator-p.lsp b/ansi-tests/special-operator-p.lsp new file mode 100644 index 00000000..d9533695 --- /dev/null +++ b/ansi-tests/special-operator-p.lsp @@ -0,0 +1,54 @@ +;-*- 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) + diff --git a/ansi-tests/symbol-name.lsp b/ansi-tests/symbol-name.lsp new file mode 100644 index 00000000..52d0d5c6 --- /dev/null +++ b/ansi-tests/symbol-name.lsp @@ -0,0 +1,43 @@ +;-*- 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) + -- GitLab