X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Finterface.pure.lisp;h=b3f8949ac87ab6d54712e207d2cbbaac86769712;hb=3bbbfec26f90bc005c2ff5c8de0ceb0f95f1a52b;hp=8c163b8476b6d4bb9261a109bc2c26bd55b22a47;hpb=be9eb6c67b5f43a095c3de17bea945c309d662e4;p=sbcl.git diff --git a/tests/interface.pure.lisp b/tests/interface.pure.lisp index 8c163b8..b3f8949 100644 --- a/tests/interface.pure.lisp +++ b/tests/interface.pure.lisp @@ -1,3 +1,5 @@ +;;;; tests for problems in the interface presented to the user/programmer + ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. ;;;; @@ -10,61 +12,18 @@ ;;;; more information. (in-package :cl-user) - -;;; Check for fbound external symbols in public packages that have no -;;; argument list information. (This used to be possible when we got -;;; carried away with byte compilation, since the byte compiler can't -;;; record argument list information. Now that there's no byte -;;; compiler, that can't happen, but it still shouldn't hurt to check -;;; in case the argument information goes astray some other way.) -(defvar *public-package-names* - '("SB-ALIEN" "SB-C-CALL" "SB-DEBUG" "SB-EXT" "SB-GRAY" "SB-MP" - "SB-PROFILE" "SB-PCL" "COMMON-LISP")) -(defun has-arglist-info-p (function) - (declare (type function function)) - ;; The Lisp-level type FUNCTION can conceal a multitude of sins.. - (case (sb-kernel:get-type function) - ((#.sb-vm:function-header-type #.sb-vm:closure-function-header-type) - (sb-kernel:%function-arglist function)) - (#.sb-vm:closure-header-type (has-arglist-info-p - (sb-kernel:%closure-function - function))) - ;; In code/describe.lisp, ll. 227 (%describe-function), we use a scheme - ;; like above, and it seems to work. -- MNA 2001-06-12 - ;; - ;; (There might be other cases with arglist info also. - ;; FUNCTION-HEADER-TYPE and CLOSURE-HEADER-TYPE just - ;; happen to be the two case that I had my nose rubbed in when - ;; debugging a GC problem caused by applying %FUNCTION-ARGLIST to - ;; a closure. -- WHN 2001-06-05) - (t nil))) -(defun check-ext-symbols-arglist (package) - (format t "~% looking at package: ~A" package) - (do-external-symbols (ext-sym package) - (when (fboundp ext-sym) - (let ((fun (symbol-function ext-sym))) - (cond ((macro-function ext-sym) - ;; FIXME: Macro functions should have their argument list - ;; information checked separately. Just feeding them into - ;; the ordinary-function logic below doesn't work right, - ;; though, and I haven't figured out what does work - ;; right. For now we just punt. - (values)) - #+nil - ((sb-int:info :function :accessor-for ext-sym) - (values)) - ((typep fun 'generic-function) - (sb-pcl::generic-function-pretty-arglist fun)) - (t - (let ((fun (symbol-function ext-sym))) - (unless (has-arglist-info-p fun) - (error "Function ~A has no arg-list information available." - ext-sym))))))))) -(dolist (public-package *public-package-names*) - (when (find-package public-package) - (check-ext-symbols-arglist public-package))) -(terpri) + +;;;; properties of symbols, e.g. presence of doc strings for public symbols ;;; FIXME: It would probably be good to require here that every ;;; external symbol either has a doc string or has some good excuse ;;; (like being an accessor for a structure which has a doc string). + +;;;; tests of interface machinery + +;;; APROPOS should accept a package designator, not just a package, and +;;; furthermore do the right thing when it gets a package designator. +;;; (bug reported and fixed by Alexey Dejneka sbcl-devel 2001-10-17) +(assert (< 0 + (length (apropos-list "PRINT" :cl)) + (length (apropos-list "PRINT"))))