Apr 9, 2008, 11:48:46 PM (13 years ago)

Add CCL:TEST-CCL - runs the gcl test suite (checking it out into ccl:tests;
if necessary). This will print out a bunch of warnings early on (for now),
then sit there for a while (about 3 mins on a MacBook? Pro) and finally
report "No tests failed".

Propagate assorted small fixes from trunk:

r8996 - fix case of spurious defvar warning
r9027 - check arg count before deciding to use builtin-call
r9046 - small fix for ~@:C
r9047 - report a TYPE-ERROR when make-broadcast-stream is given a non-output-stream
r9048 - Make make-file-stream rejected wildcarded pathnames. Various tweaks to make

meta-. work when using pathnames relative to the file system's "current directory".

r9049 - make defclass check for illegal class options
r9052 - Don't constant-fold if arg count is obviously wrong.
r9059 - Try harder to do function calls as function calls when (OPTIMIZE (SAFETY 3))

is in effect.

r9060, r9061 - CTYPE-SUBTYPE: try harder in some cases.
r9068, r9069, r9103, r9104 - PPC2-REF-SYMBOL-VALUE: force boundp checks unless

*ppc2-reckless* (same policy as x86; the per-thread binding lookup is generally
more expensive than boundp trap these days.). Unless skipping boundp check, don't
ignore unused result (so we can error when safety is 3, mostly.)

1 edited


  • branches/working-0711/ccl/level-1/l1-clos-boot.lisp

    r8918 r9117  
    3026 (defun compute-initargs-vector (instance class functions)
     3026;; This is used for compile-time defclass option checking.
     3027(defun class-keyvect (class-arg initargs)
     3028  (let* ((class (if (typep class-arg 'class) class-arg (find-class class-arg nil)))
     3029         (meta-arg (getf initargs :metaclass (if (and class (not (typep class 'forward-referenced-class)))
     3030                                               (class-of class)
     3031                                               *standard-class-class*)))
     3032         (meta-spec (if (quoted-form-p meta-arg) (%cadr meta-arg) meta-arg))
     3033         (meta (if (typep meta-spec 'class) meta-spec (find-class meta-spec))))
     3034    (compute-initargs-vector class meta (list #'initialize-instance #'allocate-instance #'shared-initialize) t)))
     3036(defun compute-initargs-vector (instance class functions &optional require-rest)
    30273037  (let ((initargs (class-slot-initargs class))
    30283038        (cpl (%inited-class-cpl class)))
    30373047                  (memq spec cpl))
    30383048            (let* ((func (%inner-method-function method))
    3039                    (keyvect (if (logbitp $lfbits-aok-bit (lfun-bits func))
    3040                               (return-from compute-initargs-vector t)
     3049                   (keyvect (if (and (logbitp $lfbits-aok-bit (lfun-bits func))
     3050                                     (or (not require-rest)
     3051                                         (logbitp $lfbits-rest-bit (lfun-bits func))))
     3052                              (return-from compute-initargs-vector t)
    30413053                              (lfun-keyvect func))))
    30423054              (dovector (key keyvect)
Note: See TracChangeset for help on using the changeset viewer.