Misc.
* Support SETF function names in SB-INTROSPECT:FUNCTION-ARGLIST.
(Patch by Todd Mokros on sbcl-devel)
* Minor performance improvement in the x86-64 assembler. (Patch
by Lutz Euler on sbcl-devel)
* Add a recursive TRACE :ENCAPSULATE NIL (supposed to be part
of a recent Solaris/x86 commit, but somehow didn't make it
through)
* Add a failing FILE-POSITION test on utf-8 streams. (Reported
by Lutz Euler)
;;; FIXME: maybe this should be renamed as FUNCTION-LAMBDA-LIST?
(defun function-arglist (function)
- "Describe the lambda list for the function designator FUNCTION.
+ "Describe the lambda list for the extended function designator FUNCTION.
Works for special-operators, macros, simple functions and generic
functions. Signals error if not found"
(cond ((valid-function-name-p function)
- (function-arglist
- (or (macro-function function) (fdefinition function))))
+ (function-arglist (or (and (symbolp function)
+ (macro-function function))
+ (fdefinition function))))
((typep function 'generic-function)
(sb-pcl::generic-function-pretty-arglist function))
(t (sb-impl::%simple-fun-arglist
(emit-mod-reg-r/m-byte segment #b11 #b000
(reg-tn-encoding dst))
(emit-signed-dword segment src))
- ((typep src `(integer ,(- (expt 2 64) (expt 2 31))
- (,(expt 2 64))))
+ ((<= (- (expt 2 64) (expt 2 31))
+ src
+ (1- (expt 2 64)))
;; This triggers on positive integers of 64 bits length
;; with the most significant 33 bits being 1. We use the
;; same encoding as in the previous clause.
(defun trace-this ()
'ok)
+(defun trace-fact (n)
+ (if (zerop n)
+ 1
+ (* n (trace-fact (1- n)))))
+
(let ((out (with-output-to-string (*trace-output*)
(trace trace-this)
(assert (eq 'ok (trace-this)))
(assert (search "TRACE-THIS" out))
(assert (search "returned OK" out))))
+#-(and (or ppc x86) darwin)
+(with-test (:name (trace-recursive :encapsulate nil)
+ :fails-on '(or ppc sparc))
+ (let ((out (with-output-to-string (*trace-output*)
+ (trace trace-fact :encapsulate nil)
+ (assert (= 120 (trace-fact 5)))
+ (untrace))))
+ (assert (search "TRACE-FACT" out))
+ (assert (search "returned 1" out))
+ (assert (search "returned 120" out))))
+
;;;; test infinite error protection
(defmacro nest-errors (n-levels error-form)
(write-string string s)
(assert (= (file-position s) (+ position string-length))))))
\f
+
+;;; See sbcl-devel "Subject: Bug in FILE-POSITION on UTF-8-encoded files"
+;;; by Lutz Euler on 2006-03-05 for more details.
+(with-test (:name (:file-position :utf-8)
+ :fails-on :sbcl)
+ (let ((path "external-format-test.txt"))
+ (with-open-file (s path
+ :direction :output
+ :if-exists :supersede
+ :element-type '(unsigned-byte 8))
+ ;; Write #\*, encoded in UTF-8, to the file.
+ (write-byte 42 s)
+ ;; Append #\adiaeresis, encoded in UTF-8, to the file.
+ (write-sequence '(195 164) s))
+ (with-open-file (s path :external-format :utf-8)
+ (read-char s)
+ (let ((pos (file-position s))
+ (char (read-char s)))
+ (format t "read character with code ~a successfully from file position ~a~%"
+ (char-code char) pos)
+ (file-position s pos)
+ (format t "set file position back to ~a, trying to read-char again~%" pos)
+ (let ((new-char (read-char s)))
+ (assert (char= char new-char)))))
+ (values)))
+
;;;; success
\ No newline at end of file
;;; 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".)
-"0.9.11.27"
+"0.9.11.28"