- mop-6 test: use keywords in test name
... because symbols from the mop-6 package cannot read later from
the file containing test results.
- fix gc deadlock test
Instead of with-all-threads-lock, it was using with-mutex that
enables interrupts.
(b :initarg :b :initform 2))
(:metaclass slot-rearrangement-class))
(b :initarg :b :initform 2))
(:metaclass slot-rearrangement-class))
-(with-test (:name (compute-slots standard-class :order))
+(with-test (:name (:compute-slots :standard-class :order))
(let ((class (find-class 'rearranged-class)))
(finalize-inheritance class)
(assert (equal (mapcar #'slot-definition-name (class-slots class))
'(b a)))))
(let ((class (find-class 'rearranged-class)))
(finalize-inheritance class)
(assert (equal (mapcar #'slot-definition-name (class-slots class))
'(b a)))))
-(with-test (:name (compute-slots standard-class :slots))
+(with-test (:name (:compute-slots :standard-class :slots))
(let ((r (make-instance 'rearranged-class))
(r2 (make-instance 'rearranged-class :a 3 :b 4)))
(assert (eql (slot-value r 'a) 1))
(let ((r (make-instance 'rearranged-class))
(r2 (make-instance 'rearranged-class :a 3 :b 4)))
(assert (eql (slot-value r 'a) 1))
(b :initarg :b :initform 2))
(:metaclass funcallable-slot-rearrangement-class))
(b :initarg :b :initform 2))
(:metaclass funcallable-slot-rearrangement-class))
-(with-test (:name (compute-slots funcallable-standard-class :order))
+(with-test (:name (:compute-slots :funcallable-standard-class :order))
(let ((class (find-class 'funcallable-rearranged-class)))
(finalize-inheritance class)
(assert (equal (mapcar #'slot-definition-name (class-slots class))
'(b a)))))
(let ((class (find-class 'funcallable-rearranged-class)))
(finalize-inheritance class)
(assert (equal (mapcar #'slot-definition-name (class-slots class))
'(b a)))))
-(with-test (:name (compute-slots funcallable-standard-class :slots))
+(with-test (:name (:compute-slots :funcallable-standard-class :slots))
(let ((r (make-instance 'funcallable-rearranged-class))
(r2 (make-instance 'funcallable-rearranged-class :a 3 :b 4)))
(assert (eql (slot-value r 'a) 1))
(assert (eql (slot-value r 'b) 2))
(assert (eql (slot-value r2 'a) 3))
(assert (eql (slot-value r2 'b) 4))))
(let ((r (make-instance 'funcallable-rearranged-class))
(r2 (make-instance 'funcallable-rearranged-class :a 3 :b 4)))
(assert (eql (slot-value r 'a) 1))
(assert (eql (slot-value r 'b) 2))
(assert (eql (slot-value r2 'a) 3))
(assert (eql (slot-value r2 'b) 4))))
-(with-test (:name (compute-slots funcallable-standard-clas :function))
+(with-test (:name (:compute-slots :funcallable-standard-clas :function))
(let ((r (make-instance 'funcallable-rearranged-class)))
(set-funcallable-instance-function r (lambda (x) (list "Hello, World!" x)))
(assert (equal (funcall r 3) '("Hello, World!" 3)))))
\ No newline at end of file
(let ((r (make-instance 'funcallable-rearranged-class)))
(set-funcallable-instance-function r (lambda (x) (list "Hello, World!" x)))
(assert (equal (funcall r 3) '("Hello, World!" 3)))))
\ No newline at end of file
;; but the same can happen because of a regular
;; MAKE-THREAD or LIST-ALL-THREADS, and various
;; session functions.
;; but the same can happen because of a regular
;; MAKE-THREAD or LIST-ALL-THREADS, and various
;; session functions.
- (sb-thread:with-mutex (sb-thread::*all-threads-lock*)
+ (sb-thread::with-all-threads-lock
(sb-thread::with-session-lock (sb-thread::*session*)
(sb-ext:gc))))
:name (list :gc i)))
(sb-thread::with-session-lock (sb-thread::*session*)
(sb-ext:gc))))
:name (list :gc i)))
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)