X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-introspect%2Ftest-driver.lisp;h=2e82fe0f033e5a471780aa61c5f18bffc9d4d833;hb=c0578d9893429c9c0da80ea5920360e4621fddab;hp=8762f2b64d7e26027d4789f7f01a4b77369bc205;hpb=29086bb980d535d7686c54f551e351a50205468e;p=sbcl.git diff --git a/contrib/sb-introspect/test-driver.lisp b/contrib/sb-introspect/test-driver.lisp index 8762f2b..2e82fe0 100644 --- a/contrib/sb-introspect/test-driver.lisp +++ b/contrib/sb-introspect/test-driver.lisp @@ -7,12 +7,12 @@ (with-compilation-unit (:source-plist (list :test-outer "OUT")) (load (compile-file (merge-pathnames "test.lisp" *load-pathname*)))) -(assert (equal (function-arglist 'cl-user::one) +(assert (equal (function-lambda-list 'cl-user::one) '(cl-user::a cl-user::b cl-user::c))) -(assert (equal (function-arglist 'the) +(assert (equal (function-lambda-list 'the) '(sb-c::value-type sb-c::form))) -(assert (equal (function-arglist #'(sb-pcl::slow-method cl-user::j (t))) +(assert (equal (function-lambda-list #'(sb-pcl::slow-method cl-user::j (t))) '(sb-pcl::method-args sb-pcl::next-methods))) (let ((source (find-definition-source #'cl-user::one))) @@ -71,16 +71,20 @@ (assert (matchp-name :method-combination 'cl-user::r 26)) (assert (matchp-name :setf-expander 'cl-user::s 27)) +(let ((fin (make-instance 'sb-mop:funcallable-standard-object))) + (sb-mop:set-funcallable-instance-function fin #'cl-user::one) + (assert (matchp fin 2))) + (sb-profile:profile cl-user::one) (assert (matchp-name :function 'cl-user::one 2)) (sb-profile:unprofile cl-user::one) -;;;; Check correctness of FUNCTION-ARGLIST. +;;;; Check correctness of FUNCTION-LAMBDA-LIST. -(assert (equal (function-arglist 'cl-user::one) +(assert (equal (function-lambda-list 'cl-user::one) '(cl-user::a cl-user::b cl-user::c))) -(assert (equal (function-arglist 'the) +(assert (equal (function-lambda-list 'the) '(sb-c::value-type sb-c::form))) ;;; Check wrt. interplay of generic functions and their methods. @@ -99,7 +103,7 @@ ;; (multiple-value-bind (required optional restp rest keyp keys allowp auxp aux morep more-context more-count) - (sb-int:parse-lambda-list (function-arglist #'xuuq)) + (sb-int:parse-lambda-list (function-lambda-list #'xuuq)) (assert (equal required '(gf.a gf.b))) (assert (null optional)) (assert (and restp (eql rest 'gf.rest))) @@ -117,7 +121,7 @@ (defmethod kroolz (r1 r2 &optional opt &aux aux) (declare (ignore r1 r2 opt aux)) 'kroolz) -(assert (equal (function-arglist #'kroolz) '(r1 r2 &optional opt))) +(assert (equal (function-lambda-list #'kroolz) '(r1 r2 &optional opt))) ;;;; Test finding a type that isn't one (assert (not (find-definition-sources-by-name 'fboundp :type)))