From 46dddbfef93ef40af0119978063bf87738dc733d Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Tue, 11 Apr 2006 08:37:22 +0000 Subject: [PATCH] 0.9.11.28: 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) --- contrib/sb-introspect/sb-introspect.lisp | 7 ++++--- src/compiler/x86-64/insts.lisp | 5 +++-- tests/debug.impure.lisp | 16 ++++++++++++++++ tests/external-format.impure.lisp | 26 ++++++++++++++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 50 insertions(+), 6 deletions(-) diff --git a/contrib/sb-introspect/sb-introspect.lisp b/contrib/sb-introspect/sb-introspect.lisp index d614307..a5ff21f 100644 --- a/contrib/sb-introspect/sb-introspect.lisp +++ b/contrib/sb-introspect/sb-introspect.lisp @@ -380,12 +380,13 @@ If an unsupported TYPE is requested, the function will return NIL. ;;; 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 diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp index 43317d3..73ca2ef 100644 --- a/src/compiler/x86-64/insts.lisp +++ b/src/compiler/x86-64/insts.lisp @@ -1515,8 +1515,9 @@ (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. diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp index bd9526d..ae18ce5 100644 --- a/tests/debug.impure.lisp +++ b/tests/debug.impure.lisp @@ -340,6 +340,11 @@ (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))) @@ -361,6 +366,17 @@ (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) diff --git a/tests/external-format.impure.lisp b/tests/external-format.impure.lisp index a642770..ec676c8 100644 --- a/tests/external-format.impure.lisp +++ b/tests/external-format.impure.lisp @@ -255,4 +255,30 @@ (write-string string s) (assert (= (file-position s) (+ position string-length)))))) + +;;; 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 diff --git a/version.lisp-expr b/version.lisp-expr index fabbb7d..070213e 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; 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" -- 1.7.10.4