0.9.11.28:
authorJuho Snellman <jsnell@iki.fi>
Tue, 11 Apr 2006 08:37:22 +0000 (08:37 +0000)
committerJuho Snellman <jsnell@iki.fi>
Tue, 11 Apr 2006 08:37:22 +0000 (08:37 +0000)
        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
src/compiler/x86-64/insts.lisp
tests/debug.impure.lisp
tests/external-format.impure.lisp
version.lisp-expr

index d614307..a5ff21f 100644 (file)
@@ -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
index 43317d3..73ca2ef 100644 (file)
                 (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.
index bd9526d..ae18ce5 100644 (file)
 (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)
index a642770..ec676c8 100644 (file)
       (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
index fabbb7d..070213e 100644 (file)
@@ -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"