diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index 6be71749bad20eaeba9e6a9461e532f534c8ebd1..6777782169fe2f77470092ca5bfc6b761bfae177 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -356,6 +356,8 @@ the condition to go uncaught if it cannot be classified." (defun is-t-or-nil (e) (or (eqt e t) (eqt e nil))) +(declaim (special *subtype-table*)) + (defun types-6-body () (loop for p in *subtype-table* count diff --git a/ansi-tests/cl-symbol-names.lsp b/ansi-tests/cl-symbol-names.lsp index f93786a30a61f494c9b9b81725e2341586cbe9e7..ee235f9c10eacd03deaf86ffbfc6eab2f737853e 100644 --- a/ansi-tests/cl-symbol-names.lsp +++ b/ansi-tests/cl-symbol-names.lsp @@ -989,3 +989,1049 @@ "Y-OR-N-P" "YES-OR-NO-P" "ZEROP")) + +;;; Symbols classified by their kind in the spec +(defparameter *cl-function-symbols* + '( + * + + + - + / + /= + 1+ + 1- + < + <= + = + > + >= + abort + abs + acons + acos + acosh + adjoin + adjust-array + adjustable-array-p + alpha-char-p + alphanumericp + append + apply + apropos + apropos-list + arithmetic-error-operands + arithmetic-error-operation + array-dimension + array-dimensions + array-displacement + array-element-type + array-has-fill-pointer-p + array-in-bounds-p + array-rank + array-row-major-index + array-total-size + arrayp + ash + asin + asinh + assoc-if-not + assoc + assoc-if + atan + atanh + atom + bit-and + bit-andc1 + bit-andc2 + bit-eqv + bit-ior + bit-nand + bit-nor + bit-not + bit-orc1 + bit-orc2 + bit-vector-p + bit-xor + boole + both-case-p + boundp + break + broadcast-stream-streams + butlast + byte + byte-position + byte-size + ceiling + cell-error-name + cerror + char-code + char-downcase + char-equal + char-greaterp + char-int + char-lessp + char-name + char-not-equal + char-not-greaterp + char-not-lessp + char-upcase + char/= + char< + char<= + char= + char> + char>= + character + characterp + cis + class-of + clear-input + clear-output + close + clrhash + code-char + coerce + compile + compile-file + compile-file-pathname + compiled-function-p + complement + complex + complexp + compute-restarts + concatenate + concatenated-stream-streams + conjugate + cons + consp + constantly + constantp + continue + copy-alist + copy-list + copy-pprint-dispatch + copy-readtable + copy-seq + copy-structure + copy-symbol + copy-tree + cos + cosh + count + count-if + count-if-not + decode-float + decode-universal-time + delete + delete-duplicates + delete-file + delete-if + delete-if-not + delete-package + denominator + deposit-field + describe + digit-char + digit-char-p + directory + directory-namestring + disassemble + dpb + dribble + echo-stream-input-stream + echo-stream-output-stream + ;;; The function ED is commented out because an implementation + ;;; needn't provide this function. + ;; ed + encode-universal-time + endp + enough-namestring + ensure-directories-exist + ensure-generic-function + eq + eql + equal + equalp + error + eval + evenp + every + exp + export + expt + fboundp + fceiling + ffloor + file-author + file-error-pathname + file-length + file-namestring + file-position + file-write-date + find + find-all-symbols + find-if + find-if-not + find-package + find-restart + find-symbol + finish-output + float + float-digits + float-precision + float-radix + float-sign + floatp + floor + fmakunbound + force-output + format + fresh-line + fround + funcall + function-lambda-expression + functionp + gcd + gensym + gentemp + get-decoded-time + get-dispatch-macro-character + get-internal-real-time + get-internal-run-time + get-macro-character + get-output-stream-string + get-properties + get-setf-expansion + get-universal-time + graphic-char-p + hash-table-count + hash-table-p + hash-table-rehash-size + hash-table-rehash-threshold + hash-table-size + hash-table-test + host-namestring + identity + imagpart + import + input-stream-p + inspect + integer-decode-float + integer-length + integerp + interactive-stream-p + intern + intersection + invalid-method-error + invoke-debugger + invoke-restart + invoke-restart-interactively + isqrt + keywordp + last + lcm + ldb-test + ldiff + length + lisp-implementation-type + lisp-implementation-version + list + list* + list-all-packages + list-length + listen + listp + load + load-logical-pathname-translations + log + logand + logandc1 + logandc2 + logbitp + logcount + logeqv + logical-pathname + logior + lognand + lognor + lognot + logorc1 + logorc2 + logtest + logxor + long-site-name + lower-case-p + machine-instance + machine-type + machine-version + macroexpand + macroexpand-1 + make-array + make-broadcast-stream + make-concatenated-stream + make-condition + make-dispatch-macro-character + make-echo-stream + make-hash-table + make-list + make-load-form-saving-slots + make-package + make-pathname + make-random-state + make-sequence + make-string + make-string-input-stream + make-string-output-stream + make-symbol + make-synonym-stream + make-two-way-stream + makunbound + map + map-into + mapc + mapcan + mapcar + mapcon + maphash + mapl + maplist + max + member + member-if + member-if-not + merge + merge-pathnames + method-combination-error + min + minusp + mismatch + mod + muffle-warning + name-char + namestring + nbutlast + nconc + nintersection + not + notany + notevery + nreconc + nreverse + nset-difference + nset-exclusive-or + nstring-capitalize + nstring-downcase + nstring-upcase + nsublis + nsubst + nsubst-if + nsubst-if-not + nsubstitute + nsubstitute-if + nsubstitute-if-not + nthcdr + null + numberp + numerator + nunion + oddp + open + open-stream-p + output-stream-p + package-error-package + package-name + package-nicknames + package-shadowing-symbols + package-use-list + package-used-by-list + packagep + pairlis + parse-integer + parse-namestring + pathname + pathname-device + pathname-directory + pathname-host + pathname-match-p + pathname-name + pathname-type + pathname-version + pathnamep + peek-char + phase + plusp + position + position-if + position-if-not + pprint + pprint-dispatch + pprint-fill + pprint-indent + pprint-linear + pprint-newline + pprint-tab + pprint-tabular + prin1 + prin1-to-string + princ + princ-to-string + print + print-not-readable-object + probe-file + proclaim + provide + random-state-p + rassoc + rassoc-if + rassoc-if-not + rational + rationalize + rationalp + read + read-byte + read-char + read-char-no-hang + read-delimited-list + read-from-string + read-line + read-preserving-whitespace + read-sequence + readtablep + realp + realpart + reduce + rem + remhash + remove + remove-duplicates + remove-if + remove-if-not + remprop + rename-file + rename-package + replace + require + restart-name + revappend + reverse + room + round + rplaca + rplacd + scale-float + search + set + set-difference + set-dispatch-macro-character + set-exclusive-or + set-macro-character + set-pprint-dispatch + set-syntax-from-char + shadow + shadowing-import + short-site-name + signal + signum + simple-bit-vector-p + simple-condition-format-arguments + simple-condition-format-control + simple-string-p + simple-vector-p + sin + sinh + slot-exists-p + sleep + slot-boundp + slot-makunbound + slot-value + software-type + software-version + some + sort + special-operator-p + sqrt + stable-sort + standard-char-p + store-value + stream-element-type + stream-error-stream + stream-external-format + streamp + string + string-capitalize + string-downcase + string-equal + string-greaterp + string-left-trim + string-lessp + string-not-equal + string-not-greaterp + string-not-lessp + string-right-trim + string-trim + string-upcase + string/= + string< + string<= + string= + string> + string>= + stringp + sublis + subsetp + subst + subst-if + subst-if-not + substitute + substitute-if + substitute-if-not + subtypep + sxhash + symbol-name + symbol-package + symbolp + synonym-stream-symbol + tailp + tan + tanh + terpri + translate-logical-pathname + translate-pathname + tree-equal + truename + truncate ftruncate + two-way-stream-input-stream + two-way-stream-output-stream + type-error-datum + type-error-expected-type + type-of + typep + unbound-slot-instance + unexport + unintern + union + unread-char + unuse-package + upgraded-array-element-type + upgraded-complex-part-type + upper-case-p + use-package + use-value + user-homedir-pathname + values-list + vector + vector-pop + vector-push + vector-push-extend + vectorp + warn + wild-pathname-p + write + write-byte + write-char + write-line + write-sequence + write-string + write-to-string + y-or-n-p + yes-or-no-p + zerop + )) + +(defparameter *cl-variable-symbols* + '( + * + ** + *** + *break-on-signals* + *compile-file-pathname* + *compile-file-truename* + *compile-print* + *compile-verbose* + *debug-io* + *debugger-hook* + *default-pathname-defaults* + *error-output* + *features* + *gensym-counter* + *load-pathname* + *load-print* + *load-truename* + *load-verbose* + *macroexpand-hook* + *modules* + *package* + *print-array* + *print-base* + *print-case* + *print-circle* + *print-escape* + *print-gensym* + *print-length* + *print-level* + *print-lines* + *print-miser-width* + *print-pprint-dispatch* + *print-pretty* + *print-radix* + *print-readably* + *print-right-margin* + *query-io* + *random-state* + *read-base* + *read-default-float-format* + *read-eval* + *read-suppress* + *readtable* + *standard-input* + *standard-output* + *terminal-io* + *trace-output* + + + ++ + +++ + / + // + /// + )) + +(defparameter *cl-constant-symbols* + '( + array-dimension-limit + array-rank-limit + array-total-size-limit + boole-1 + boole-2 + boole-and + boole-andc1 + boole-andc2 + boole-c1 + boole-c2 + boole-clr + boole-eqv + boole-ior + boole-nand + boole-nor + boole-orc1 + boole-orc2 + boole-set + boole-xor + call-arguments-limit + char-code-limit + double-float-epsilon + double-float-negative-epsilon + internal-time-units-per-second + lambda-list-keywords + lambda-parameters-limit + least-negative-double-float + least-negative-long-float + least-negative-normalized-double-float + least-negative-normalized-long-float + least-negative-normalized-short-float + least-negative-normalized-single-float + least-negative-short-float + least-negative-single-float + least-positive-double-float + least-positive-long-float + least-positive-normalized-double-float + least-positive-normalized-long-float + least-positive-normalized-short-float + least-positive-normalized-single-float + least-positive-short-float + least-positive-single-float + long-float-epsilon + long-float-negative-epsilon + most-negative-double-float + most-negative-fixnum + most-negative-long-float + most-negative-short-float + most-negative-single-float + most-positive-double-float + most-positive-fixnum + most-positive-long-float + most-positive-short-float + most-positive-single-float + nil + pi + short-float-epsilon + short-float-negative-epsilon + single-float-epsilon + single-float-negative-epsilon + t + )) + +(defparameter *cl-macro-symbols* + '( + and + assert + case + ccase + ecase + check-type + cond + declaim + defclass + defconstant + defgeneric + define-compiler-macro + define-condition + define-method-combination + define-modify-macro + define-setf-expander + define-symbol-macro + defmacro + defmethod + defpackage + defparameter + defvar + defsetf + defstruct + deftype + defun + destructuring-bind + do + do* + do-symbols + do-external-symbols + do-all-symbols + dolist + dotimes + formatter + handler-bind + handler-case + ignore-errors + in-package + incf + decf + lambda + loop + multiple-value-bind + multiple-value-list + multiple-value-setq + nth-value + or + pop + pprint-logical-block + print-unreadable-object + prog + prog* + prog1 + prog2 + psetq + push + pushnew + remf + restart-bind + restart-case + return + rotatef + setf + psetf + shiftf + step + time + trace + untrace + typecase + ctypecase + etypecase + when + unless + with-accessors + with-compilation-unit + with-condition-restarts + with-hash-table-iterator + with-input-from-string + with-open-file + with-open-stream + with-output-to-string + with-package-iterator + with-simple-restart + with-slots + with-standard-io-syntax + )) + +(defparameter *cl-accessor-symbols* + '( + aref + bit + caaaar + caaadr + caaar + caadar + caaddr + caadr + caar + cadaar + cadadr + cadar + caddar + cadddr + caddr + cadr + car + cdaaar + cdaadr + cdaar + cdadar + cdaddr + cdadr + cdar + cddaar + cddadr + cddar + cdddar + cddddr + cdddr + cddr + cdr + char + compiler-macro-function + eighth + elt + fdefinition + fifth + fill-pointer + find-class + first + fourth + get + getf + gethash + ldb + logical-pathname-translations + macro-function + mask-field + ninth + nth + readtable-case + rest + row-major-aref + sbit + schar + second + seventh + sixth + subseq + svref + symbol-function + symbol-plist + symbol-value + tenth + third + values + )) + +(defparameter *cl-condition-type-symbols* + '( + arithmetic-error + cell-error + condition + control-error + division-by-zero + end-of-file + error + file-error + floating-point-inexact + floating-point-invalid-operation + floating-point-overflow + floating-point-underflow + package-error + parse-error + print-not-readable + program-error + reader-error + serious-condition + simple-condition + simple-error + simple-type-error + simple-warning + storage-condition + stream-error + style-warning + type-error + unbound-slot + unbound-variable + undefined-function + warning + )) + +(defparameter *cl-class-symbols* + '(standard-object structure-object)) + +(defparameter *cl-declaration-symbols* + '( + declaration + dynamic-extent + ftype + ignore + ignorable + inline + notinline + optimize + special + type)) + +(defparameter *cl-local-function-symbols* + '(call-next-method next-method-p)) + +(defparameter *cl-local-macro-symbols* + '( + call-method + make-method + loop-finish + pprint-exit-if-list-exhausted + pprint-pop + )) + +(defparameter *cl-special-operator-symbols* + '( + block + catch + eval-when + flet + function + go + if + labels + let + let* + load-time-value + locally + macrolet + multiple-value-call + multiple-value-prog1 + progn + progv + quote + return-from + setq + symbol-macrolet + tagbody + the + throw + unwind-protect +)) + +(defparameter *cl-standard-generic-function-symbols* + '( + add-method + allocate-instance + change-class + class-name + compute-applicable-methods + describe-object + documentation + find-method + function-keywords + initialize-instance + make-instance + make-instances-obsolete + make-load-form + method-qualifiers + no-applicable-method + no-next-method + print-object + reinitialize-instance + remove-method + shared-initialize + slot-missing + slot-unbound + update-instance-for-different-class + update-instance-for-redefined-class + )) + +(defparameter *cl-system-class-symbols* + '( + array + bit-vector + broadcast-stream + built-in-class + character + class + complex + concatenated-stream + cons + echo-stream + file-stream + float + function + generic-function + hash-table + integer + list + logical-pathname + method + method-combination + null + number + package + pathname + random-state + ratio + rational + readtable + real + restart + sequence + standard-class + standard-generic-function + standard-method + stream + string + string-stream + structure-class + symbol + synonym-stream + t + two-way-stream + vector + )) + +(defparameter *cl-type-symbols* + '( + atom + base-char + base-string + bignum + bit + boolean + compiled-function + extended-char + fixnum + keyword + nil + short-float + single-float + double-float + long-float + signed-byte + simple-array + simple-base-string + simple-bit-vector + simple-string + simple-vector + standard-char + unsigned-byte + )) + +(defparameter *cl-type-specifier-symbols* + '( + and + eql + member + mod + not + or + satisfies + values + )) + +(defparameter *cl-restart-symbols* + '( + abort + continue + muffle-warning + store-value + use-value + )) diff --git a/ansi-tests/cl-symbols-aux.lsp b/ansi-tests/cl-symbols-aux.lsp new file mode 100644 index 0000000000000000000000000000000000000000..a27e8b5f30e4c444e8172c9b9998f06ba20ead68 --- /dev/null +++ b/ansi-tests/cl-symbols-aux.lsp @@ -0,0 +1,44 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Thu Nov 28 06:43:51 2002 +;;;; Contains: Aux. functions for cl-symbols.lsp + +(in-package :cl-test) + +(declaim (optimize (safety 3))) + +(defun is-external-symbol-of (sym package) + (multiple-value-bind (sym2 status) + (find-symbol (symbol-name sym) package) + (and (eqt sym sym2) + (eqt status :external)))) + +(defun test-if-not-in-cl-package (str) + (multiple-value-bind (sym status) + (find-symbol (string-upcase str) 'common-lisp) + (declare (ignore sym)) + (or + ;; Symbol not present in the common lisp package + (not status) + ;; Check if it has any properties whose indicators are + ;; external in any of the standard packages or are accessible + ;; in CL-USER + (and (eqt status :external) + (let ((plist (symbol-plist sym))) + (loop for e = plist then (cddr e) + while e + for indicator = (car e) + when (and (symbolp indicator) + (or (is-external-symbol-of indicator + "COMMON-LISP") + (is-external-symbol-of indicator "KEYWORD") + (eqt indicator (find-symbol + (symbol-name indicator) + "COMMON-LISP-USER")))) + collect indicator)))))) + +(defun safe-symbol-name (sym) + (catch-type-error (symbol-name sym))) + +(defun safe-make-symbol (name) + (catch-type-error (make-symbol name))) diff --git a/ansi-tests/cl-symbols.lsp b/ansi-tests/cl-symbols.lsp index 6da71a75eebcc9386c5b9bc56b3b45432bdb5a9c..f72bd182a041fc2d9a040e3c86e24b4ba717e2dd 100644 --- a/ansi-tests/cl-symbols.lsp +++ b/ansi-tests/cl-symbols.lsp @@ -9,34 +9,6 @@ (declaim (optimize (safety 3))) -(defun is-external-symbol-of (sym package) - (multiple-value-bind (sym2 status) - (find-symbol (symbol-name sym) package) - (and (eqt sym sym2) - (eqt status :external)))) - -(defun test-if-not-in-cl-package (str) - (multiple-value-bind (sym status) - (find-symbol (string-upcase str) 'common-lisp) - (declare (ignore sym)) - (or - ;; Symbol not present in the common lisp package - (not status) - ;; Check if it has any properties whose indicators are - ;; external in any of the standard packages or are accessible - ;; in CL-USER - (and (eqt status :external) - (let ((plist (symbol-plist sym))) - (loop for e = plist then (cddr e) - while e - for indicator = (car e) - when (and (symbolp indicator) - (or (is-external-symbol-of indicator "COMMON-LISP") - (is-external-symbol-of indicator "KEYWORD") - (eqt indicator (find-symbol (symbol-name indicator) - "COMMON-LISP-USER")))) - collect indicator)))))) - ;;; Test for the presence of every darned symbol ;;; the standard says should be in the CL package. ;;; Also, test that they have no prohibited plist indicators (section 11.1.2.1.1) @@ -1100,9 +1072,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; symbol-name -(defun safe-symbol-name (sym) - (catch-type-error (symbol-name sym))) - (deftest symbol-name-1 (safe-symbol-name '|ABCD|) "ABCD") @@ -1167,9 +1136,6 @@ (symbol-plist (make-symbol "C")) nil) -(defun safe-make-symbol (name) - (catch-type-error (make-symbol name))) - (deftest make-symbol-9 (safe-make-symbol nil) type-error) @@ -1404,3 +1370,51 @@ (deftest gensym-19 (catch-type-error (gensym #\x)) type-error) + +;;;;;;;;;;;;;;;;;;;; + +;;; Tests of CL package constraints from section 11.1.2.1.1 + +;;; Check that all symbols listed as 'functions' or 'accessors' +;;; are indeed functions. + +(deftest cl-function-symbols.1 + (loop + for s in (append *cl-function-symbols* *cl-accessor-symbols*) + when (or (not (fboundp s)) + (macro-function s) + (special-operator-p s) + (not (symbol-function s))) + collect s) + nil) + +;;; Check that all symols listed as 'macros' are macros. + +(deftest cl-macro-symbols.1 + (loop + for s in *cl-macro-symbols* + when (or (not (fboundp s)) + (not (macro-function s))) + collect s) + nil) + +;;; Check that all constants are indeed constant + +(deftest cl-constant-symbols.1 + (loop + for s in *cl-constant-symbols* + when (or (not (boundp s)) + (not (constantp s))) + collect s) + nil) + +;;; Check that all global variables have values + +(deftest cl-variable-symbols.1 + (loop + for s in *cl-variable-symbols* + when (not (boundp s)) + collect s) + nil) + + diff --git a/ansi-tests/gclload2.lsp b/ansi-tests/gclload2.lsp index 976489fc2e8d2edc406f967dfd57b8272be5a5ba..70045028dc9b11927d2e4bd78a0d198904692348 100644 --- a/ansi-tests/gclload2.lsp +++ b/ansi-tests/gclload2.lsp @@ -1,6 +1,7 @@ ;;; Load individual test files ;;; Tests of symbols +(compile-and-load "cl-symbols-aux.lsp") (load "cl-symbol-names.lsp") (load "cl-symbols.lsp") @@ -8,6 +9,7 @@ (load "eval.lsp") (load "eval-and-compile.lsp") (load "compile.lsp") +(load "lambda.lsp") ;;; Tests of data and control flow diff --git a/ansi-tests/lambda.lsp b/ansi-tests/lambda.lsp new file mode 100644 index 0000000000000000000000000000000000000000..d3751a8e658eeee09d91cc368e8f1ab316e83ed4 --- /dev/null +++ b/ansi-tests/lambda.lsp @@ -0,0 +1,60 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Nov 27 06:43:21 2002 +;;;; Contains: Tests of LAMBDA forms + +(in-package :cl-test) + +(deftest lambda.1 + ((lambda (x) x) 'a) + a) + +(deftest lambda.2 + ((lambda () 'a)) + a) + +(deftest lambda.3 + ((lambda () "documentation" 'a)) + a) + +(deftest lambda.4 + ((lambda (x) (declare (type symbol x)) x) 'z) + z) + +(deftest lambda.5 + ((lambda (&aux (x 'a)) x)) + a) + +(deftest lambda.6 + ((lambda (&aux (x 'a)) (declare (type symbol x)) x)) + a) + +(deftest lambda.7 + ((lambda () "foo")) + "foo") + +(deftest lambda.8 + ((lambda () "foo" "bar")) + "bar") + +(deftest lambda.9 + ((lambda (x y) (declare (ignore x)) "foo" (declare (ignore y)) "bar") 1 2) + "bar") + +(deftest lambda.10 + ((lambda (x) (declare (type symbol x))) 'z) + nil) + +;;; Should test lambda argument lists more fully here + +;;; Tests of lambda as a macro + +(deftest lambda.macro.1 + (notnot (macro-function 'lambda)) + t) + +(deftest lambda.macro.2 + (funcall (eval (macroexpand '(lambda () 10)))) + 10) + + \ No newline at end of file