126:
(fixed in 0.pre7.41)
+127:
+ The DEFSTRUCT section of the ANSI spec, in the :CONC-NAME section,
+ specifies a precedence rule for name collisions between slot accessors of
+ structure classes related by inheritance. As of 0.7.0, SBCL still
+ doesn't follow it.
+
KNOWN BUGS RELATED TO THE IR1 INTERPRETER
(debug-signal 'no-debug-blocks
:debug-fun debug-fun)))))
-;;; This returns a SIMPLE-VECTOR of DEBUG-BLOCKs or NIL. NIL indicates
-;;; there was no basic block information.
+;;; Return a SIMPLE-VECTOR of DEBUG-BLOCKs or NIL. NIL indicates there
+;;; was no basic block information.
(defun parse-debug-blocks (debug-fun)
(etypecase debug-fun
(compiled-debug-fun
;;; This value should be incremented when the system changes in such
;;; a way that it will no longer work reliably with old fasl files.
-(defconstant +fasl-file-version+ 20)
+(defconstant +fasl-file-version+ 21)
;;; 2 = sbcl-0.6.4 uses COMPILE-OR-LOAD-DEFGENERIC.
;;; 3 = sbcl-0.6.6 uses private symbol, not :EMPTY, for empty HASH-TABLE slot.
;;; 4 = sbcl-0.6.7 uses HAIRY-DATA-VECTOR-REF and HAIRY-DATA-VECTOR-SET
;;; the PPC port
;;; (In 0.pre7.48, the low-level object layout of SYMBOL on the
;;; non-X86 ports changed. I forgot to bump the fasl version number:
-;;; I only have an X86..)
+;;; I only have an X86.. -- WHN)
;;; 19 = sbcl-0.pre7.50 deleted byte-compiler-related low-level type codes
;;; 20 = sbcl-0.pre7.51 modified names and layouts of
;;; physical-environment-related structures in the compiler
+;;; 21 = sbcl-0.pre7.62 finally incremented the version after several
+;;; incompatible changes in earlier versions: many many symbols
+;;; renamed, changes in globaldb representation of constants
+;;; and inline functions, and change in the value of
+;;; INTERNAL-TIME-UNITS-PER-SECOND
;;; the conventional file extension for our fasl files
(declaim (type simple-string *fasl-file-type*))
(in-package "SB!IMPL")
-(defconstant internal-time-units-per-second 100
+(defconstant sb!xc:internal-time-units-per-second 1000
#!+sb-doc
"The number of internal time units that fit into a second. See
GET-INTERNAL-REAL-TIME and GET-INTERNAL-RUN-TIME.")
(defconstant micro-seconds-per-internal-time-unit
- (/ 1000000 internal-time-units-per-second))
+ (/ 1000000 sb!xc:internal-time-units-per-second))
\f
;;; The base number of seconds for our internal "epoch". We initialize
;;; this to the time of the first call to GET-INTERNAL-REAL-TIME, and
(truly-the (unsigned-byte 32)
(+ (the (unsigned-byte 32)
(* (the (unsigned-byte 32) (- seconds base))
- internal-time-units-per-second))
+ sb!xc:internal-time-units-per-second))
uint)))
(t
(setq *internal-real-time-base-seconds* seconds)
(let ((result (+ (the (unsigned-byte 32)
(* (the (unsigned-byte 32) (+ utime-sec stime-sec))
- internal-time-units-per-second))
+ sb!xc:internal-time-units-per-second))
(floor (+ utime-usec
stime-usec
(floor micro-seconds-per-internal-time-unit 2))
~S page fault~:P and~% ~
~S bytes consed.~%"
(max (/ (- new-real-time old-real-time)
- (float internal-time-units-per-second))
+ (float sb!xc:internal-time-units-per-second))
0.0)
(max (/ (- new-run-utime old-run-utime) 1000000.0) 0.0)
(max (/ (- new-run-stime old-run-stime) 1000000.0) 0.0)
(unless (zerop gc-run-time)
(/ (float gc-run-time)
- (float internal-time-units-per-second)))
+ (float sb!xc:internal-time-units-per-second)))
(max (- new-page-faults old-page-faults) 0)
(max (- new-bytes-consed old-bytes-consed) 0)))))))
`(nth-value 1
(ignore-errors ,@body)))
-(defmacro raises-error? (&body body)
- `(typep (nth-value 1 (ignore-errors ,@body)) 'error))
+(defmacro raises-error? (form &optional (error-subtype-spec 'error))
+ `(typep (nth-value 1 (ignore-errors ,form)) ',error-subtype-spec))
;;; EXPR is an expression to evaluate (both with EVAL and with
;;; COMPILE/FUNCALL). EXTRA-OPTIMIZATIONS is a list of lists of
;;; LAMBDA. EXPECTED-EQL, EXPECTED-EQUAL, and EXPECTED-EQUALP are
;;; shorthand for special cases of EXPECTED-LAMBDA.
;;;
-;;; Use EXPECTED-ERROR to require an error to be thrown. Use
-;;; EXPECTED-ERROR-LAMBDA to require that an error be thrown and
+;;; Use EXPECTED-ERROR to require an error to be signalled. Use
+;;; EXPECTED-ERROR-LAMBDA to require that an error be signalled and
;;; that further it satisfies the given lambda.
(defmacro assertoid (expr
&key
(lambda (bugid)
(setf (gethash bugid *bugid->knownp*)
t))
- #())
+ #(;; FIXME: several metaproblems here, over and above the primary
+ ;; problem represented by the honking big bug list..
+ ;; * This list was generated automatically from test output
+ ;; from my locally patched copy of ansi-test. I can't
+ ;; use the CVS version of ansi-test until they patch it
+ ;; it to support BUGIDs; and there's no guarantee that
+ ;; * Once BUGIDs are stable, there should probably be comments
+ ;; for bugs and groups of bugs explaining what's going on.
+ ;; * Once BUGIDs are stable, the ansi-test-related entries in
+ ;; BUGS should probably be deleted in favor of the BUGIDs
+ ;; and comments here.
+ :ALLTEST-LEGACY-77
+ :ALLTEST-LEGACY-391
+ :ALLTEST-LEGACY-1605
+ :ALLTEST-LEGACY-1613
+ :ALLTEST-LEGACY-1715
+ :ALLTEST-LEGACY-1723
+ :ALLTEST-LEGACY-2204
+ :CLOS-LEGACY-170
+ :CMUCL-BUGS-LEGACY-292
+ :CMUCL-BUGS-LEGACY-501
+ :CMUCL-BUGS-LEGACY-517
+ :CMUCL-BUGS-LEGACY-580
+ :CONDITIONS-LEGACY-70
+ :CONDITIONS-LEGACY-74
+ :CONDITIONS-LEGACY-78
+ :CONDITIONS-LEGACY-82
+ :CONDITIONS-LEGACY-86
+ :CONDITIONS-LEGACY-90
+ :CONDITIONS-LEGACY-94
+ :CONDITIONS-LEGACY-98
+ :CONDITIONS-LEGACY-102
+ :CONDITIONS-LEGACY-106
+ :CONDITIONS-LEGACY-110
+ :CONDITIONS-LEGACY-114
+ :CONDITIONS-LEGACY-118
+ :CONDITIONS-LEGACY-122
+ :CONDITIONS-LEGACY-126
+ :CONDITIONS-LEGACY-130
+ :CONDITIONS-LEGACY-134
+ :CONDITIONS-LEGACY-138
+ :CONDITIONS-LEGACY-142
+ :CONDITIONS-LEGACY-146
+ :CONDITIONS-LEGACY-150
+ :CONDITIONS-LEGACY-154
+ :CONDITIONS-LEGACY-158
+ :CONDITIONS-LEGACY-162
+ :CONDITIONS-LEGACY-166
+ :CONDITIONS-LEGACY-170
+ :CONDITIONS-LEGACY-174
+ :CONDITIONS-LEGACY-178
+ :CONDITIONS-LEGACY-182
+ :CONDITIONS-LEGACY-201
+ :CONDITIONS-LEGACY-209
+ :CONDITIONS-LEGACY-217
+ :EXCEPSIT-LEGACY-77
+ :EXCEPSIT-LEGACY-85
+ :EXCEPSIT-LEGACY-125
+ :EXCEPSIT-LEGACY-133
+ :EXCEPSIT-LEGACY-145
+ :EXCEPSIT-LEGACY-149
+ :EXCEPSIT-LEGACY-165
+ :EXCEPSIT-LEGACY-174
+ :EXCEPSIT-LEGACY-211
+ :EXCEPSIT-LEGACY-267
+ :EXCEPSIT-LEGACY-271
+ :EXCEPSIT-LEGACY-275
+ :EXCEPSIT-LEGACY-279
+ :EXCEPSIT-LEGACY-283
+ :EXCEPSIT-LEGACY-287
+ :EXCEPSIT-LEGACY-291
+ :EXCEPSIT-LEGACY-295
+ :EXCEPSIT-LEGACY-299
+ :EXCEPSIT-LEGACY-311
+ :EXCEPSIT-LEGACY-323
+ :EXCEPSIT-LEGACY-360
+ :EXCEPSIT-LEGACY-368
+ :EXCEPSIT-LEGACY-377
+ :EXCEPSIT-LEGACY-386
+ :EXCEPSIT-LEGACY-395
+ :EXCEPSIT-LEGACY-404
+ :EXCEPSIT-LEGACY-413
+ :EXCEPSIT-LEGACY-465
+ :EXCEPSIT-LEGACY-621
+ :EXCEPSIT-LEGACY-664
+ :EXCEPSIT-LEGACY-684
+ :EXCEPSIT-LEGACY-712
+ :EXCEPSIT-LEGACY-740
+ :EXCEPSIT-LEGACY-796
+ :EXCEPSIT-LEGACY-807
+ :EXCEPSIT-LEGACY-863
+ :EXCEPSIT-LEGACY-875
+ :EXCEPSIT-LEGACY-899
+ :EXCEPSIT-LEGACY-903
+ :EXCEPSIT-LEGACY-935
+ :EXCEPSIT-LEGACY-947
+ :EXCEPSIT-LEGACY-951
+ :EXCEPSIT-LEGACY-971
+ :EXCEPSIT-LEGACY-995
+ :EXCEPSIT-LEGACY-1007
+ :EXCEPSIT-LEGACY-1015
+ :EXCEPSIT-LEGACY-1054
+ :EXCEPSIT-LEGACY-1058
+ :EXCEPSIT-LEGACY-1197
+ :EXCEPSIT-LEGACY-1201
+ :EXCEPSIT-LEGACY-1269
+ :EXCEPSIT-LEGACY-1273
+ :EXCEPSIT-LEGACY-1327
+ :EXCEPSIT-LEGACY-1357
+ :EXCEPSIT-LEGACY-1369
+ :EXCEPSIT-LEGACY-1381
+ :EXCEPSIT-LEGACY-1397
+ :EXCEPSIT-LEGACY-1401
+ :EXCEPSIT-LEGACY-1405
+ :EXCEPSIT-LEGACY-1445
+ :EXCEPSIT-LEGACY-1546
+ :EXCEPSIT-LEGACY-1567
+ :EXCEPSIT-LEGACY-1571
+ :FORMAT-LEGACY-302
+ :FORMAT-LEGACY-308
+ :FORMAT-LEGACY-322
+ :FORMAT-LEGACY-334
+ :HASHLONG-LEGACY-61
+ :IOFKTS-LEGACY-68
+ :IOFKTS-LEGACY-72
+ :IOFKTS-LEGACY-76
+ :IOFKTS-LEGACY-737
+ :IOFKTS-LEGACY-775
+ :IOFKTS-LEGACY-791
+
+ ;; (These aren't really separate bugs, but 804 depends on a
+ ;; side-effect of 791, then 812 depends on a side effect of
+ ;; 804, so that as long as 791 is suppressed we need to
+ ;; suppress these too.)
+ :IOFKTS-LEGACY-804
+ :IOFKTS-LEGACY-812
+
+ :IOFKTS-LEGACY-881
+ :IOFKTS-LEGACY-894
+ :LAMBDA-LEGACY-226
+ :LISTS152-LEGACY-491
+ :LISTS152-LEGACY-500
+ :LISTS155-LEGACY-123
+ :LOOP-LEGACY-222
+ :MACRO8-LEGACY-126
+ :NEW-BUGS-LEGACY-26
+ :SECTION12-LEGACY-78
+ :SECTION12-LEGACY-775
+ :SECTION12-LEGACY-789
+ :SECTION12-LEGACY-833
+ :SECTION12-LEGACY-849
+ :SECTION17-LEGACY-93
+ :SECTION17-LEGACY-99
+ :SECTION17-LEGACY-105
+ :SECTION17-LEGACY-632
+ :SECTION17-LEGACY-674
+ :SECTION22-LEGACY-200
+ :SECTION3-LEGACY-410
+ :SECTION3-LEGACY-669
+ :SECTION3-LEGACY-686
+ :SECTION3-LEGACY-703
+ :SECTION3-LEGACY-718
+ :SECTION3-LEGACY-733
+ :SECTION3-LEGACY-750
+ :SECTION3-LEGACY-783
+ :SECTION3-LEGACY-807
+ :SECTION3-LEGACY-812
+ :SECTION3-LEGACY-816
+ :SECTION3-LEGACY-820
+ :SECTION3-LEGACY-824
+ :SECTION3-LEGACY-832
+ :SECTION3-LEGACY-844
+ :SECTION4-LEGACY-111
+ :SECTION4-LEGACY-115
+ :SECTION4-LEGACY-119
+ :SECTION4-LEGACY-123
+ :SECTION4-LEGACY-127
+ :SECTION4-LEGACY-131
+ :SECTION4-LEGACY-135
+ :SECTION4-LEGACY-208
+ :SECTION4-LEGACY-295
+ :SECTION6-LEGACY-162
+ :SETF-LEGACY-233
+ :SETF-LEGACY-346
+ :SETF-LEGACY-420
+ :SETF-LEGACY-426
+ :SETF-LEGACY-433
+ :SETF-LEGACY-480
+ :SETF-LEGACY-499
+ :SETF-LEGACY-504
+ :STREAMS-LEGACY-10
+ :STREAMS-LEGACY-938
+ :STREAMS-LEGACY-944
+ :STREAMS-LEGACY-951
+ :STREAMS-LEGACY-1269
+ :STREAMS-LEGACY-1297
+ :STRINGS-LEGACY-1241
+ :STRINGS-LEGACY-1281
+ :STRINGS-LEGACY-1320
+ :SYMBOL10-LEGACY-87
+ :SYMBOL10-LEGACY-95
+ :SYMBOL10-LEGACY-104
+ :SYMBOL10-LEGACY-115
+ :SYMBOL10-LEGACY-124
+ :SYMBOL10-LEGACY-135
+ :SYMBOL10-LEGACY-146
+ :SYMBOL10-LEGACY-159
+ :SYMBOL10-LEGACY-168
+ :SYMBOL10-LEGACY-177
+ :SYMBOL10-LEGACY-184
+ :SYMBOL10-LEGACY-188
+ :SYMBOL10-LEGACY-192
+ :SYMBOL10-LEGACY-196
+ :SYMBOL10-LEGACY-203
+ :SYMBOL10-LEGACY-206
+ :SYMBOL10-LEGACY-209
+ :SYMBOL10-LEGACY-219
+ :SYMBOL10-LEGACY-224
+ :SYMBOL10-LEGACY-237
+ :SYMBOL10-LEGACY-244
+ :SYMBOL10-LEGACY-254
+ :SYMBOL10-LEGACY-259
+ :SYMBOL10-LEGACY-262
+ :SYMBOL10-LEGACY-265
+ :SYMBOL10-LEGACY-269
+ :SYMBOL10-LEGACY-279
+ :SYMBOL10-LEGACY-282
+ :SYMBOL10-LEGACY-285
+ :SYMBOL10-LEGACY-289
+ :SYMBOL10-LEGACY-300
+ :SYMBOL10-LEGACY-303
+ :SYMBOL10-LEGACY-306
+ :SYMBOL10-LEGACY-310
+ :SYMBOL10-LEGACY-324
+ :SYMBOL10-LEGACY-330
+ :SYMBOL10-LEGACY-342
+ :SYMBOL10-LEGACY-360
+ :SYMBOL10-LEGACY-382
+ :SYMBOL10-LEGACY-394
+ :SYMBOL10-LEGACY-398
+ :SYMBOL10-LEGACY-417
+ :SYMBOL10-LEGACY-428
+ :SYMBOL10-LEGACY-438
+ :SYMBOL10-LEGACY-442
+ :SYMBOL10-LEGACY-446
+ :SYMBOL10-LEGACY-452
+ :SYMBOL10-LEGACY-466
+ :SYMBOL10-LEGACY-477
+ :SYMBOL10-LEGACY-490
+ :SYMBOL10-LEGACY-495
+ :SYMBOL10-LEGACY-499
+ :SYMBOL10-LEGACY-503
+ :SYMBOL10-LEGACY-513
+ :SYMBOL10-LEGACY-516
+ :SYMBOL10-LEGACY-519
+ :SYMBOL10-LEGACY-532
+ :SYMBOL10-LEGACY-536
+ :SYMBOL10-LEGACY-540
+ :SYMBOL10-LEGACY-549
+ :SYMBOL10-LEGACY-554
+ :SYMBOL10-LEGACY-560
+ :SYMBOL10-LEGACY-563
+ :SYMBOL10-LEGACY-567
+ :SYMBOL10-LEGACY-574
+ :SYMBOL10-LEGACY-577
+ :SYMBOL10-LEGACY-581
+ :SYMBOL10-LEGACY-586
+ :SYMBOL10-LEGACY-589
+ :SYMBOL10-LEGACY-593
+ :SYMBOL10-LEGACY-604
+ :SYMBOL10-LEGACY-616
+ :SYMBOL10-LEGACY-620
+ :SYMBOL10-LEGACY-632
+ :SYMBOL10-LEGACY-636
+ :SYMBOL10-LEGACY-640
+ :SYMBOL10-LEGACY-644
+ :SYMBOL10-LEGACY-657
+ :SYMBOL10-LEGACY-662
+ :SYMBOL10-LEGACY-668
+ :SYMBOL10-LEGACY-672
+ :SYMBOL10-LEGACY-676
+ :SYMBOL10-LEGACY-689
+ :SYMBOL10-LEGACY-698
+ :TYPE-LEGACY-298
+ :TYPE-LEGACY-351))
#!/bin/sh
-# Run clocc's ansi-test suite on SBCL.
+# Run clocc's ansi-test suite on SBCL (if you set the appropriate
+# environment variable so that the test suite, a separate piece of
+# software, can be found).
#
# This is implemented as a shell script because ansi-test likes to
# report its errors on standard output and it's convenient to use the
# Find clocc ansi-test (or just punt, returning success).
if [ "$SBCL_CLOCC_ANSI_TEST" = "" ] ; then
- echo punting clocc ansi-test because SBCL_CLOCC_ANSI_TEST is undefined
+ echo //punting clocc ansi-test because SBCL_CLOCC_ANSI_TEST is undefined
exit 104
else
+ echo //going on to run clocc ansi-test in $SBCL_CLOCC_ANSI_TEST
cd $SBCL_CLOCC_ANSI_TEST
fi
bugsfilename="$tmpprefix-bugs.tmp"
# Go SBCL go.
-$SBCL <<EOF | tee $rawfilename
+$SBCL <<EOF >$rawfilename
(in-package :cl-user)
;;; Tell ansi-test about our known bugs.
(load "$originalpwd/clocc-ansi-test-known-bugs.lisp")
(load "tests.lisp")
;;; Return a special status code to show that we reached the end
;;; normally instead of taking a dirt nap.
+(print "back from ansi-test tests.lisp")
(sb-ext:quit :unix-status 52)
EOF
if [ $? != 52 ]; then
exit 1
fi
-# Klingon programmers detect errors by searching for error tags in
-# standard output.
+# Klingon programmers handle errors by recognizing error strings
+# in standard output.
if egrep 'ERROR!!' $rawfilename > $bugsfilename; then
# new bugs, better luck next time
cat $bugsfilename
--- /dev/null
+;;;; 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")
+\f
+;;;; examples from, or close to, the Common Lisp DEFSTRUCT spec
+
+;;; Type mismatch of slot default init value isn't an error until the
+;;; default init value is actually used. (The justification is
+;;; somewhat bogus, but the requirement is clear.)
+(defstruct person age (name 007 :type string)) ; not an error until 007 used
+(make-person :name "James") ; not an error, 007 not used
+(assert (raises-error? (make-person) type-error))
+;;; FIXME: broken structure slot type checking in sbcl-0.pre7.62
+#+nil (assert (raises-error? (setf (person-name (make-person "Q")) 1) type-error))
+
+;;; basic inheritance
+(defstruct (astronaut (:include person)
+ (:conc-name astro-))
+ helmet-size
+ (favorite-beverage 'tang))
+(let ((x (make-astronaut :name "Buzz" :helmet-size 17.5)))
+ (assert (equal (person-name x) "Buzz"))
+ (assert (equal (astro-name x) "Buzz"))
+ (assert (eql (astro-favorite-beverage x) 'tang))
+ (assert (null (astro-age x))))
+(defstruct (ancient-astronaut (:include person (age 77)))
+ helmet-size
+ (favorite-beverage 'tang))
+(assert (eql (ancient-astronaut-age (make-ancient-astronaut :name "John")) 77))
+
+;;; interaction of :TYPE and :INCLUDE and :INITIAL-OFFSET
+(defstruct (binop (:type list) :named (:initial-offset 2))
+ (operator '? :type symbol)
+ operand-1
+ operand-2)
+(defstruct (annotated-binop (:type list)
+ (:initial-offset 3)
+ (:include binop))
+ commutative associative identity)
+(assert (equal (make-annotated-binop :operator '*
+ :operand-1 'x
+ :operand-2 5
+ :commutative t
+ :associative t
+ :identity 1)
+ '(nil nil binop * x 5 nil nil nil t t 1)))
+
+;;; effect of :NAMED on :TYPE
+(defstruct (named-binop (:type list) :named)
+ (operator '? :type symbol)
+ operand-1
+ operand-2)
+(let ((named-binop (make-named-binop :operator '+ :operand-1 'x :operand-2 5)))
+ ;; The data representation is specified to look like this.
+ (assert (equal named-binop '(named-binop + x 5)))
+ ;; A meaningful NAMED-BINOP-P is defined.
+ (assert (named-binop-p named-binop))
+ (assert (named-binop-p (copy-list named-binop)))
+ (assert (not (named-binop-p (cons 11 named-binop))))
+ (assert (not (named-binop-p (find-package :cl)))))
+
+;;; example 1
+(defstruct town
+ area
+ watertowers
+ (firetrucks 1 :type fixnum)
+ population
+ (elevation 5128 :read-only t))
+(let ((town1 (make-town :area 0 :watertowers 0)))
+ (assert (town-p town1))
+ (assert (not (town-p 1)))
+ (assert (eql (town-area town1) 0))
+ (assert (eql (town-elevation town1) 5128))
+ (assert (null (town-population town1)))
+ (setf (town-population town1) 99)
+ (assert (eql (town-population town1) 99))
+ (let ((town2 (copy-town town1)))
+ (dolist (slot-accessor-name '(town-area
+ town-watertowers
+ town-firetrucks
+ town-population
+ town-elevation))
+ (assert (eql (funcall slot-accessor-name town1)
+ (funcall slot-accessor-name town2))))
+ (assert (not (fboundp '(setf town-elevation)))))) ; 'cause it's :READ-ONLY
+
+;;; example 2
+(defstruct (clown (:conc-name bozo-))
+ (nose-color 'red)
+ frizzy-hair-p
+ polkadots)
+(let ((funny-clown (make-clown)))
+ (assert (eql (bozo-nose-color funny-clown) 'red)))
+(defstruct (klown (:constructor make-up-klown)
+ (:copier clone-klown)
+ (:predicate is-a-bozo-p))
+ nose-color
+ frizzy-hair-p
+ polkadots)
+(assert (is-a-bozo-p (make-up-klown)))
+
+;;; success
+(quit :unix-status 104)
# absolutely no warranty. See the COPYING and CREDITS files for
# more information.
-testfilestem=$TMPDIR/sbcl-foreign-test-$$
+testfilestem=${TMPDIR:-/tmp}/sbcl-foreign-test-$$
echo 'int summish(int x, int y) { return 1 + x + y; }' > $testfilestem.c
make $testfilestem.o
# rolling over in his grave.:-) It would be good to make a test case
# for it..
+rm $testfilestem.*
+
# success convention for script
exit 104
(in-package "CL-USER")
-;;; Test for monotonicity of GET-INTERNAL-RUN-TIME.
+;;; Test for monotonicity of GET-INTERNAL-RUN-TIME. (On OpenBSD, this
+;;; is not a given, because of a longstanding bug in getrusage().)
(funcall (compile nil
'(lambda (n-seconds)
(declare (type fixnum n-seconds))
(when (>= time time1)
(return)))))))
3)
-
-(locally
- (declare (notinline mapcar))
- (mapcar (lambda (args)
- (destructuring-bind (obj type-spec result) args
- (flet ((matches-result? (x)
- (eq (if x t nil) result)))
- (assert (matches-result? (typep obj type-spec)))
- (assert (matches-result? (sb-kernel:ctypep
- obj
- (sb-kernel:specifier-type
- type-spec)))))))
- '((nil (or null vector) t)
- (nil (or number vector) nil)
- (12 (or null vector) nil)
- (12 (and (or number vector) real) t))))
-
-
\ No newline at end of file
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre7.62"
+"0.pre7.63"
projects / sbcl.git / commitdiff