in the not-a-CL:STREAM case, so that even when Gray streams aren't
installed, at least appropriate type errors are generated
* fixed bug 8: better reporting of various PROGRAM-ERRORs
-?? fixed bug 9: IGNORE and IGNORABLE now work reasonably in DEFMETHOD
- forms.
+* fixed bug 9: IGNORE and IGNORABLE now work reasonably and more
+ consistently in DEFMETHOD forms.
* removed bug 21 from BUGS, since Martin Atzmueller points out that
it doesn't seem to affect SBCL after all
method-lambda initargs env)
(declare (ignore proto-gf proto-method))
(unless (and (consp method-lambda) (eq (car method-lambda) 'lambda))
- (error "The METHOD-LAMBDA argument to MAKE-METHOD-FUNCTION, ~S,~
+ (error "The METHOD-LAMBDA argument to MAKE-METHOD-FUNCTION, ~S, ~
is not a lambda form."
method-lambda))
(make-method-initargs-form-internal method-lambda initargs env))
(defun make-method-lambda-internal (method-lambda &optional env)
(unless (and (consp method-lambda) (eq (car method-lambda) 'lambda))
- (error "The METHOD-LAMBDA argument to MAKE-METHOD-LAMBDA, ~S,~
+ (error "The METHOD-LAMBDA argument to MAKE-METHOD-LAMBDA, ~S, ~
is not a lambda form."
method-lambda))
(multiple-value-bind (documentation declarations real-body)
(multiple-value-bind (parameters lambda-list specializers)
(parse-specialized-lambda-list specialized-lambda-list)
(let* ((required-parameters
- (mapcar #'(lambda (r s) (declare (ignore s)) r)
+ (mapcar (lambda (r s) (declare (ignore s)) r)
parameters
specializers))
(slots (mapcar #'list required-parameters))
(calls (list nil))
- (parameters-to-reference
- (make-parameter-references specialized-lambda-list
- required-parameters
- declarations
- method-name
- specializers))
(class-declarations
`(declare
;; FIXME: Are these (DECLARE (SB-PCL::CLASS FOO BAR))
;; appropriate class declarations. The documentation
;; string is removed to make it easy for us to insert
;; new declarations later, they will just go after the
- ;; cadr of the method lambda. The class declarations
+ ;; CADR of the method lambda. The class declarations
;; are inserted to communicate the class of the method's
;; arguments to the code walk.
`(lambda ,lambda-list
+ ;; The default ignorability of method parameters
+ ;; doesn't seem to be specified by ANSI. PCL had
+ ;; them basically ignorable but was a little
+ ;; inconsistent. E.g. even though the two
+ ;; method definitions
+ ;; (DEFMETHOD FOO ((X T) (Y T)) "Z")
+ ;; (DEFMETHOD FOO ((X T) Y) "Z")
+ ;; are otherwise equivalent, PCL treated Y as
+ ;; ignorable in the first definition but not in the
+ ;; second definition. We make all required
+ ;; parameters ignorable as a way of systematizing
+ ;; the old PCL behavior. -- WHN 2000-11-24
+ (declare (ignorable ,@required-parameters))
,class-declarations
,@declarations
- (declare (ignorable ,@parameters-to-reference))
-
- ;; FIXME: should become FUNCTION-NAME-BLOCK-NAME
- (block ,(if (listp generic-function-name)
- (cadr generic-function-name)
- generic-function-name)
+ (block ,(sb-int:function-name-block-name
+ generic-function-name)
,@real-body)))
(constant-value-p (and (null (cdr real-body))
(constantp (car real-body))))
(if (memq var lambda-list-keywords)
(progn
(case var
- (&optional (setq state 'optional))
+ (&optional (setq state 'optional))
(&key (setq state 'key))
(&allow-other-keys)
- (&rest (setq state 'rest))
+ (&rest (setq state 'rest))
(&aux (setq state 'aux))
(otherwise
(error
(if (eq *boot-state* 'complete)
(standard-generic-function-p (gdefinition name))
(funcallable-instance-p (gdefinition name)))))
-
-(defun make-parameter-references (specialized-lambda-list
- required-parameters
- declarations
- method-name
- specializers)
- (flet ((ignoredp (symbol)
- (dolist (decl (cdar declarations))
- (when (and (eq (car decl) 'ignore)
- (memq symbol (cdr decl)))
- (return t)))))
- (gathering ((references (collecting)))
- (iterate ((s (list-elements specialized-lambda-list))
- (p (list-elements required-parameters)))
- (progn p)
- (cond ((not (listp s)))
- ((ignoredp (car s))
- (warn "In DEFMETHOD ~S, there is a~%~
- redundant IGNORE declaration for the parameter ~S."
- method-name
- specializers
- (car s)))
- (t
- (gather (car s) references)))))))
\f
(defvar *method-function-plist* (make-hash-table :test 'eq))
(defvar *mf1* nil)
method-name
method-lambda-list))
-;;; These are age-old functions which CommonLisp cleaned-up away. They probably
-;;; exist in other packages in all CommonLisp implementations, but I will leave
-;;; it to the compiler to optimize into calls to them.
+;;; These are age-old functions which CommonLisp cleaned-up away. They
+;;; probably exist in other packages in all CommonLisp
+;;; implementations, but I will leave it to the compiler to optimize
+;;; into calls to them.
;;;
;;; FIXME: MEMQ, ASSQ, and DELQ are already defined in SBCL, and we should
;;; use those. POSQ and NEQ aren't defined in SBCL, and are used too often
(defmacro posq (item list) `(position ,item ,list :test #'eq))
(defmacro neq (x y) `(not (eq ,x ,y)))
-;;; Rename these to CONSTANTLY-T, CONSTANTLY-NIL, and CONSTANTLY-0
+;;; FIXME: Rename these to CONSTANTLY-T, CONSTANTLY-NIL, and CONSTANTLY-0
;;; and boost them up to SB-INT.
(defun true (&rest ignore) (declare (ignore ignore)) t)
(defun false (&rest ignore) (declare (ignore ignore)) nil)
(defun zero (&rest ignore) (declare (ignore ignore)) 0)
-;;; ONCE-ONLY does the same thing as it does in zetalisp. I should have just
-;;; lifted it from there but I am honest. Not only that but this one is
-;;; written in Common Lisp. I feel a lot like bootstrapping, or maybe more
-;;; like rebuilding Rome.
+;;; ONCE-ONLY does the same thing as it does in zetalisp. I should
+;;; have just lifted it from there but I am honest. Not only that but
+;;; this one is written in Common Lisp. I feel a lot like
+;;; bootstrapping, or maybe more like rebuilding Rome.
;;;
-;;; FIXME: We should only need one ONCE-ONLY in CMU CL, and there's one
-;;; in SB-EXT already (presently to go in SB-INT). Can we use
-;;; only one of these in both places?
+;;; FIXME: We should only need one ONCE-ONLY in SBCL, and there's one
+;;; in SB-INT already. Can we use only one of these in both places?
(defmacro once-only (vars &body body)
(let ((gensym-var (gensym))
(run-time-vars (gensym))
(ecase operation
(slot-value "read the slot's value (slot-value)")
(setf (format nil
- "set the slot's value to ~S (setf of slot-value)"
+ "set the slot's value to ~S (SETF of SLOT-VALUE)"
new-value))
- (slot-boundp "test to see whether slot is bound (slot-boundp)")
- (slot-makunbound "make the slot unbound (slot-makunbound)"))
+ (slot-boundp "test to see whether slot is bound (SLOT-BOUNDP)")
+ (slot-makunbound "make the slot unbound (SLOT-MAKUNBOUND)"))
slot-name
instance))
,@forms))
(defvar *non-variable-declarations*
- ;; FIXME: VALUES was in this list, conditionalized with #+CMU, but
- ;; I don't *think* CMU CL had, or SBCL has, VALUES declarations. If
- ;; SBCL doesn't have 'em, VALUES should probably be removed from this list.
+ ;; FIXME: VALUES was in this list, conditionalized with #+CMU, but I
+ ;; don't *think* CMU CL had, or SBCL has, VALUES declarations. If
+ ;; SBCL doesn't have 'em, VALUES should probably be removed from
+ ;; this list.
'(values method-name method-lambda-list
optimize ftype inline notinline))
type))
(defvar *variable-declarations-without-argument*
- '(ignore ignorable special dynamic-extent
+ '(ignore
+ ignorable special dynamic-extent
+ ;; FIXME: Possibly this entire list and variable should go away.
+ ;; If not, certainly we should remove all these built-in typenames
+ ;; from the list, and replace them with a test for "is it a type
+ ;; name?" (CLTL1 allowed only built-in type names as declarations,
+ ;; but ANSI CL allows any type name as a declaration.)
array atom base-char bignum bit bit-vector character compiled-function
complex cons double-float extended-char
fixnum float function hash-table integer
stream string symbol t unsigned-byte vector))
(defun split-declarations (body args calls-next-method-p)
- (let ((inner-decls nil) (outer-decls nil) decl)
+ (let ((inner-decls nil)
+ (outer-decls nil)
+ decl)
(loop (when (null body) (return nil))
(setq decl (car body))
(unless (and (consp decl)
(dname (list (pop form)))
(inners nil) (outers nil))
(unless (or arg-p non-arg-p)
- ;; FIXME: This warning should probably go away now
- ;; that we're not trying to be portable between
- ;; different CLTL1 hosts the way PCL was.
+ ;; FIXME: This warning, and perhaps the
+ ;; various *VARIABLE-DECLARATIONS-FOO* and/or
+ ;; *NON-VARIABLE-DECLARATIONS* variables,
+ ;; should probably go away now that we're not
+ ;; trying to be portable between different
+ ;; CLTL1 hosts the way PCL was.
(warn "The declaration ~S is not understood by ~S.~@
Please put ~S on one of the lists ~S,~%~S, or~%~S.~@
(Assuming it is a variable declaration without argument)."
(setq dname (append dname (list (pop form)))))
(dolist (var form)
(if (member var args)
- ;; Quietly remove IGNORE declarations on args when
- ;; a next-method is involved, to prevent compiler
- ;; warns about ignored args being read.
- (unless (and calls-next-method-p
- (eq (car dname) 'ignore))
+ ;; Quietly remove IGNORE declarations on
+ ;; args when a next-method is involved, to
+ ;; prevent compiler warns about ignored
+ ;; args being read.
+ (unless (and calls-next-method-p
+ (eq (car dname) 'ignore))
(push var outers))
(push var inners)))
(when outers
(append req-args (list rest-arg))
req-args)))
`(list* :fast-function
- #'(lambda (.pv-cell. .next-method-call. ,@args+rest-arg)
- ,@outer-decls
- .pv-cell. .next-method-call.
- (macrolet ((pv-env ((pv calls pv-table-symbol pv-parameters)
- &rest forms)
- (declare (ignore pv-table-symbol pv-parameters))
- `(let ((,pv (car .pv-cell.))
- (,calls (cdr .pv-cell.)))
- (declare ,(make-pv-type-declaration pv)
- ,(make-calls-type-declaration calls))
- ,pv ,calls
- ,@forms)))
- (fast-lexical-method-functions
- (,(car lmf-params) .next-method-call. ,req-args ,rest-arg
- ,@(cdddr lmf-params))
- ,@inner-decls
- ,@body)))
+ (lambda (.pv-cell. .next-method-call. ,@args+rest-arg)
+ (declare (ignorable .pv-cell. .next-method-call.))
+ ,@outer-decls
+ (macrolet ((pv-env ((pv calls pv-table-symbol pv-parameters)
+ &rest forms)
+ (declare (ignore pv-table-symbol pv-parameters))
+ `(let ((,pv (car .pv-cell.))
+ (,calls (cdr .pv-cell.)))
+ (declare ,(make-pv-type-declaration pv)
+ ,(make-calls-type-declaration calls))
+ ,pv ,calls
+ ,@forms)))
+ (fast-lexical-method-functions
+ (,(car lmf-params) .next-method-call. ,req-args ,rest-arg
+ ,@(cdddr lmf-params))
+ ,@inner-decls
+ ,@body)))
',initargs))))
;;; Use arrays and hash tables and the fngen stuff to make this much better. It
;;;; the ASSERTOID macro, asserting something with added generality
;;;; to help in regression tests
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
(cl:in-package :cl-user)
;;; EXPR is an expression to evaluate (both with EVAL and with
+;;;; miscellaneous compiler tests with side-effects (e.g. DEFUN
+;;;; changing FDEFINITIONs and globaldb stuff)
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
(cl:in-package :cl-user)
(declaim (optimize (debug 3) (speed 2) (space 1)))
;;;; settings). Similar tests which *do* expect special settings may
;;;; be in files compiler-1.impure.lisp, compiler-2.impure.lisp, etc.
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
(cl:in-package :cl-user)
(load "assertoid.lisp")
+;;;; various compiler tests without side-effects
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
(cl:in-package :cl-user)
;;; Exercise a compiler bug (by crashing the compiler).
;;;; various patches made around May 2000 added support for this to
;;;; CMU CL. This file contains tests of their functionality.
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
(cl:in-package :cl-user)
;;; This block of eight assertions is taken directly from
+;;;; side-effectful tests of MAP-related stuff
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
(cl:in-package :cl-user)
(load "assertoid.lisp")
+;;;; miscellaneous side-effectful tests of CLOS
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
(defpackage "FOO"
(:use "CL"))
(in-package "FOO")
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
-;;;; This software is derived from the CMU CL system, which was
-;;;; written at Carnegie Mellon University and released into the
-;;;; public domain. The software is in the public domain and is
-;;;; provided with absolutely no warranty. See the COPYING and CREDITS
-;;;; files for more information.
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
(in-package "CL-USER")
# tests related to SB-EXT:RUN-PROGRAM
+# This software is part of the SBCL system. See the README file for
+# more information.
+#
+# While most of SBCL is derived from the CMU CL system, the test
+# files (like this one) were written from scratch after the fork
+# from CMU CL.
+#
+# This software is in the public domain and is provided with
+# absolutely no warranty. See the COPYING and CREDITS files for
+# more information.
+
sbcl --noinform --noprint --sysinit /dev/null --userinit /dev/null <<EOF
(let ((string (with-output-to-string (stream)
(sb-ext:run-program "/bin/echo"
# Run the regression tests in this directory.
+# This software is part of the SBCL system. See the README file for
+# more information.
+#
+# While most of SBCL is derived from the CMU CL system, the test
+# files (like this one) were written from scratch after the fork
+# from CMU CL.
+#
+# This software is in the public domain and is provided with
+# absolutely no warranty. See the COPYING and CREDITS files for
+# more information.
+
# how we invoke SBCL
sbcl=${1:-../src/runtime/sbcl --core ../output/sbcl.core --noinform --noprint --noprogrammer}
;;;; a stress test for the garbage collector
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
;;;; TO DO:
;;;; * Add conses:
;;;; ** Make REPR-CONS.
#!/bin/sh
+# This software is part of the SBCL system. See the README file for
+# more information.
+#
+# While most of SBCL is derived from the CMU CL system, the test
+# files (like this one) were written from scratch after the fork
+# from CMU CL.
+#
+# This software is in the public domain and is provided with
+# absolutely no warranty. See the COPYING and CREDITS files for
+# more information.
+
sbcl <<EOF
(compile-file "WHN/stress-gc.lisp")
(load *)
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
(cl:in-package :cl-user)
(funcall (lambda ()
;;; versions, and a string like "0.6.5.12" is used for versions which
;;; aren't released but correspond only to CVS tags or snapshots.
-"0.6.8.24"
+"0.6.8.25"
projects / sbcl.git / commitdiff