From: Nikodemus Siivola Date: Thu, 26 Oct 2006 16:07:52 +0000 (+0000) Subject: 0.9.18.9: Pathname Love on Win32 X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=fb8e5ded0b56f50de2024efbcc9ce68b401415f5;p=sbcl.git 0.9.18.9: Pathname Love on Win32 * Namestring simplification (was UNIX-SIMPLIFY-PATHNAME) is now function of the host. Shamelessly cargo-culted Win32 version from the Unix version. * Kludged %ENUMERATE-DIRECTORIES to work with :WILD-INFERIORS on Win32. * Fix UNPARSE-NATIVE-WIN32-NAMESTRING to handle #P"X:\\FOO" case correctly. ("X:\\FOO", not "X:\\\\FOO") * Missing NEWS entry for 0.9.18.8. * Correct order of arguments to MERGE-PATHNAMES in SYSINIT-PATHNAME. * Couple of WITH-TEST additions to test-suite. --- diff --git a/NEWS b/NEWS index 03be969..2b7fcc9 100644 --- a/NEWS +++ b/NEWS @@ -4,12 +4,16 @@ changes in sbcl-0.9.19 (1.0.0?) relative to sbcl-0.9.18: core, and restored on startup. * improvement: GET-INTERNAL-REAL-TIME now reports the time since startup, not time since first call to GET-INTERNAL-REAL-TIME. + * bug fix: compiler bug triggered by a (non-standard) VALUES + declaration in a LET* was fixed. * improvements to the Windows port: ** floating point exceptions are now reported correctly. ** stack exhaustion detection works partially. ** more accurate GET-INTERNAL-REAL-TIME. ** better RUN-PROGRAM behaviour in case of errors in the child process. + ** PROBE-FILE now simplifies pathnames correctly. + ** DIRECTORY now works correctly with :WILD-INFERIORS. changes in sbcl-0.9.18 (1.0.beta?) relative to sbcl-0.9.17: * enhancement: SB-POSIX now supports cfsetispeed(3), cfsetospeed(3), diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 96dd458..00d63e5 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -778,8 +778,8 @@ Lisp extension proposal by David N. Gray" :name "SB!INT" :doc "private: miscellaneous unsupported extensions to the ANSI spec. Much of -the stuff in here originated in CMU CL's EXTENSIONS package and is -retained, possibly temporariliy, because it might be used internally." +the stuff in here originated in CMU CL's EXTENSIONS package and is retained, +possibly temporariliy, because it might be used internally." :use ("CL" "SB!ALIEN" "SB!GRAY" "SB!FASL" "SB!SYS") :export (;; lambda list keyword extensions "&MORE" @@ -856,6 +856,7 @@ retained, possibly temporariliy, because it might be used internally." "PHYSICALIZE-PATHNAME" "SANE-DEFAULT-PATHNAME-DEFAULTS" "SBCL-HOMEDIR-PATHNAME" + "SIMPLIFY-NAMESTRING" ;; PCOUNTERs "FASTBIG-INCF-PCOUNTER-OR-FIXNUM" @@ -2041,7 +2042,7 @@ no guarantees of interface stability." "UNIX-FILE-KIND" "UNIX-KILL" "CODESET" "TCSETPGRP" "FD-ZERO" "FD-CLR" "CHECK" "UNIX-RESOLVE-LINKS" "FD-SETSIZE" "TCGETPGRP" "UNIX-FAST-GETRUSAGE" - "UNIX-SIMPLIFY-PATHNAME" "UNIX-KILLPG" + "UNIX-KILLPG" "TIOCSIGSEND" "C-IFLAG" "C-LFLAG" "C-OFLAG" "C-CFLAG" "TCSAFLUSH" "C-CC" "SIOCSPGRP" "TERMIOS" diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp index f323df9..f91ae33 100644 --- a/src/code/filesys.lisp +++ b/src/code/filesys.lisp @@ -252,6 +252,8 @@ follow-links nodes function &aux (host (pathname-host pathname))) (declare (simple-string head)) + #!+win32 + (setf follow-links nil) (macrolet ((unix-xstat (name) `(if follow-links (sb!unix:unix-stat ,name) @@ -302,6 +304,8 @@ sb!unix:s-ifdir)) (unless (dolist (dir nodes nil) (when (and (eql (car dir) dev) + #!+win32 ;; KLUDGE + (not (zerop ino)) (eql (cdr dir) ino)) (return t))) (let ((nodes (cons (cons dev ino) nodes)) @@ -479,11 +483,11 @@ (defun truename (pathname) #!+sb-doc "Return the pathname for the actual file described by PATHNAME. - An error of type FILE-ERROR is signalled if no such file exists, - or the pathname is wild. +An error of type FILE-ERROR is signalled if no such file exists, or the +pathname is wild. - Under Unix, the TRUENAME of a broken symlink is considered to be - the name of the broken symlink itself." +Under Unix, the TRUENAME of a broken symlink is considered to be the name of +the broken symlink itself." (let ((result (probe-file pathname))) (unless result (error 'simple-file-error @@ -495,7 +499,7 @@ (defun probe-file (pathname) #!+sb-doc "Return a pathname which is the truename of the file if it exists, or NIL - otherwise. An error of type FILE-ERROR is signaled if pathname is wild." +otherwise. An error of type FILE-ERROR is signaled if pathname is wild." (let* ((defaulted-pathname (merge-pathnames pathname (sane-default-pathname-defaults))) @@ -504,7 +508,9 @@ (let ((trueishname (sb!unix:unix-resolve-links namestring))) (when trueishname (let* ((*ignore-wildcards* t) - (name (sb!unix:unix-simplify-pathname trueishname))) + (name (simplify-namestring + trueishname + (pathname-host defaulted-pathname)))) (if (eq (sb!unix:unix-file-kind name) :directory) ;; FIXME: this might work, but it's ugly. (pathname (concatenate 'string name "/")) @@ -811,8 +817,8 @@ system." ;; grounds that the implementation should have repeatable ;; behavior when possible. (sort (loop for name being each hash-key in truenames - using (hash-value truename) - collect (cons name truename)) + using (hash-value truename) + collect (cons name truename)) #'string< :key #'car)))) diff --git a/src/code/pathname.lisp b/src/code/pathname.lisp index cea8b13..542aa09 100644 --- a/src/code/pathname.lisp +++ b/src/code/pathname.lisp @@ -26,6 +26,7 @@ (unparse-file (missing-arg) :type function) (unparse-enough (missing-arg) :type function) (unparse-directory-separator (missing-arg) :type simple-string) + (simplify-namestring (missing-arg) :type function) (customary-case (missing-arg) :type (member :upper :lower))) (def!method print-object ((host host) stream) @@ -51,6 +52,7 @@ (unparse-file #'unparse-logical-file) (unparse-enough #'unparse-enough-namestring) (unparse-directory-separator ";") + (simplify-namestring #'identity) (customary-case :upper))) (name "" :type simple-string) (translations nil :type list) diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp index f57d5b3..eee1e6a 100644 --- a/src/code/target-pathname.lisp +++ b/src/code/target-pathname.lisp @@ -27,6 +27,7 @@ (unparse-file #'unparse-unix-file) (unparse-enough #'unparse-unix-enough) (unparse-directory-separator "/") + (simplify-namestring #'simplify-unix-namestring) (customary-case :lower)))) (defvar *unix-host* (make-unix-host)) (defun make-unix-host-load-form (host) @@ -45,8 +46,9 @@ (unparse-file #'unparse-win32-file) (unparse-enough #'unparse-win32-enough) (unparse-directory-separator "\\") + (simplify-namestring #'simplify-win32-namestring) (customary-case :upper)))) -(defvar *win32-host* (make-win32-host)) +(defparameter *win32-host* (make-win32-host)) (defun make-win32-host-load-form (host) (declare (ignore host)) '*win32-host*) @@ -525,12 +527,10 @@ the operating system native pathname conventions." (error "~S is not allowed as a directory component." piece)))) (results))) (simple-string - `(:absolute - ,(maybe-diddle-case directory diddle-case))) + `(:absolute ,(maybe-diddle-case directory diddle-case))) (string `(:absolute - ,(maybe-diddle-case (coerce directory 'simple-string) - diddle-case))))) + ,(maybe-diddle-case (coerce directory 'simple-string) diddle-case))))) (defun make-pathname (&key host (device nil devp) @@ -858,7 +858,8 @@ a host-structure or string." (let* ((end (%check-vector-sequence-bounds namestr start end))) (multiple-value-bind (new-host device directory file type version) (cond - (host (funcall (host-parse-native host) namestr start end)) + (host + (funcall (host-parse-native host) namestr start end)) ((pathname-host defaults) (funcall (host-parse-native (pathname-host defaults)) namestr @@ -1282,6 +1283,12 @@ PARSE-NAMESTRING." ;;;; utilities +(defun simplify-namestring (namestring &optional host) + (funcall (host-simplify-namestring + (or host + (pathname-host (sane-default-pathname-defaults)))) + namestring)) + ;;; Canonicalize a logical pathname word by uppercasing it checking that it ;;; contains only legal characters. (defun logical-word-or-lose (word) @@ -1682,3 +1689,4 @@ PARSE-NAMESTRING." ;; FIXME: now that we have a SYS host that the system uses, it ;; might be cute to search in "SYS:TRANSLATIONS;.LISP" (error "logical host ~S not found" host))) + diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index fcd8a5e..ef3f173 100644 --- a/src/code/toplevel.lisp +++ b/src/code/toplevel.lisp @@ -41,7 +41,7 @@ (defun sysinit-pathname () (or (let ((sbcl-homedir (sbcl-homedir-pathname))) (when sbcl-homedir - (probe-file (merge-pathnames sbcl-homedir "sbclrc")))) + (probe-file (merge-pathnames "sbclrc" sbcl-homedir)))) #!+win32 (merge-pathnames "sbcl\\sbclrc" (sb!win32::get-folder-pathname diff --git a/src/code/unix-pathname.lisp b/src/code/unix-pathname.lisp index 99a4b35..b4c4d59 100644 --- a/src/code/unix-pathname.lisp +++ b/src/code/unix-pathname.lisp @@ -318,3 +318,89 @@ (strings ".") (strings (unparse-unix-piece pathname-type)))) (apply #'concatenate 'simple-string (strings))))) + +(defun simplify-unix-namestring (src) + (declare (type simple-string src)) + (let* ((src-len (length src)) + (dst (make-string src-len :element-type 'character)) + (dst-len 0) + (dots 0) + (last-slash nil)) + (macrolet ((deposit (char) + `(progn + (setf (schar dst dst-len) ,char) + (incf dst-len)))) + (dotimes (src-index src-len) + (let ((char (schar src src-index))) + (cond ((char= char #\.) + (when dots + (incf dots)) + (deposit char)) + ((char= char #\/) + (case dots + (0 + ;; either ``/...' or ``...//...' + (unless last-slash + (setf last-slash dst-len) + (deposit char))) + (1 + ;; either ``./...'' or ``..././...'' + (decf dst-len)) + (2 + ;; We've found .. + (cond + ((and last-slash (not (zerop last-slash))) + ;; There is something before this .. + (let ((prev-prev-slash + (position #\/ dst :end last-slash :from-end t))) + (cond ((and (= (+ (or prev-prev-slash 0) 2) + last-slash) + (char= (schar dst (- last-slash 2)) #\.) + (char= (schar dst (1- last-slash)) #\.)) + ;; The something before this .. is another .. + (deposit char) + (setf last-slash dst-len)) + (t + ;; The something is some directory or other. + (setf dst-len + (if prev-prev-slash + (1+ prev-prev-slash) + 0)) + (setf last-slash prev-prev-slash))))) + (t + ;; There is nothing before this .., so we need to keep it + (setf last-slash dst-len) + (deposit char)))) + (t + ;; something other than a dot between slashes + (setf last-slash dst-len) + (deposit char))) + (setf dots 0)) + (t + (setf dots nil) + (setf (schar dst dst-len) char) + (incf dst-len)))))) + (when (and last-slash (not (zerop last-slash))) + (case dots + (1 + ;; We've got ``foobar/.'' + (decf dst-len)) + (2 + ;; We've got ``foobar/..'' + (unless (and (>= last-slash 2) + (char= (schar dst (1- last-slash)) #\.) + (char= (schar dst (- last-slash 2)) #\.) + (or (= last-slash 2) + (char= (schar dst (- last-slash 3)) #\/))) + (let ((prev-prev-slash + (position #\/ dst :end last-slash :from-end t))) + (if prev-prev-slash + (setf dst-len (1+ prev-prev-slash)) + (return-from simplify-unix-namestring + (coerce "./" 'simple-string)))))))) + (cond ((zerop dst-len) + "./") + ((= dst-len src-len) + dst) + (t + (subseq dst 0 dst-len))))) diff --git a/src/code/unix.lisp b/src/code/unix.lisp index 40cfd07..c0a3b8f 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -907,7 +907,7 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." (if (null link) (return pathname) (let ((new-pathname - (unix-simplify-pathname + (simplify-namestring (if (relative-unix-pathname? link) (let* ((dir-len (1+ (position #\/ pathname @@ -928,93 +928,6 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." (if (member pathname previous-pathnames :test #'string=) (return pathname) (push pathname previous-pathnames)))) - -(defun unix-simplify-pathname (src) - (declare (type simple-string src)) - (let* ((src-len (length src)) - (dst (make-string src-len :element-type 'character)) - (dst-len 0) - (dots 0) - (last-slash nil)) - (macrolet ((deposit (char) - `(progn - (setf (schar dst dst-len) ,char) - (incf dst-len)))) - (dotimes (src-index src-len) - (let ((char (schar src src-index))) - (cond ((char= char #\.) - (when dots - (incf dots)) - (deposit char)) - ((char= char #\/) - (case dots - (0 - ;; either ``/...' or ``...//...' - (unless last-slash - (setf last-slash dst-len) - (deposit char))) - (1 - ;; either ``./...'' or ``..././...'' - (decf dst-len)) - (2 - ;; We've found .. - (cond - ((and last-slash (not (zerop last-slash))) - ;; There is something before this .. - (let ((prev-prev-slash - (position #\/ dst :end last-slash :from-end t))) - (cond ((and (= (+ (or prev-prev-slash 0) 2) - last-slash) - (char= (schar dst (- last-slash 2)) #\.) - (char= (schar dst (1- last-slash)) #\.)) - ;; The something before this .. is another .. - (deposit char) - (setf last-slash dst-len)) - (t - ;; The something is some directory or other. - (setf dst-len - (if prev-prev-slash - (1+ prev-prev-slash) - 0)) - (setf last-slash prev-prev-slash))))) - (t - ;; There is nothing before this .., so we need to keep it - (setf last-slash dst-len) - (deposit char)))) - (t - ;; something other than a dot between slashes - (setf last-slash dst-len) - (deposit char))) - (setf dots 0)) - (t - (setf dots nil) - (setf (schar dst dst-len) char) - (incf dst-len)))))) - (when (and last-slash (not (zerop last-slash))) - (case dots - (1 - ;; We've got ``foobar/.'' - (decf dst-len)) - (2 - ;; We've got ``foobar/..'' - (unless (and (>= last-slash 2) - (char= (schar dst (1- last-slash)) #\.) - (char= (schar dst (- last-slash 2)) #\.) - (or (= last-slash 2) - (char= (schar dst (- last-slash 3)) #\/))) - (let ((prev-prev-slash - (position #\/ dst :end last-slash :from-end t))) - (if prev-prev-slash - (setf dst-len (1+ prev-prev-slash)) - (return-from unix-simplify-pathname - (coerce "./" 'simple-string)))))))) - (cond ((zerop dst-len) - "./") - ((= dst-len src-len) - dst) - (t - (subseq dst 0 dst-len))))) - ;;; UNIX specific code, that has been cleanly separated from the ;;; Windows build. diff --git a/src/code/win32-pathname.lisp b/src/code/win32-pathname.lisp index 08cad05..81ddebd 100644 --- a/src/code/win32-pathname.lisp +++ b/src/code/win32-pathname.lisp @@ -31,14 +31,14 @@ ;; Next, split the remainder into slash-separated chunks. (collect ((pieces)) (loop - (let ((slash (position-if (lambda (c) - (or (char= c #\/) - (char= c #\\))) - namestr :start start :end end))) - (pieces (cons start (or slash end))) - (unless slash - (return)) - (setf start (1+ slash)))) + (let ((slash (position-if (lambda (c) + (or (char= c #\/) + (char= c #\\))) + namestr :start start :end end))) + (pieces (cons start (or slash end))) + (unless slash + (return)) + (setf start (1+ slash)))) (values absolute (pieces))))) (defun parse-win32-namestring (namestring start end) @@ -109,7 +109,7 @@ for piece = (subseq namestring start end) collect (if (and (string= piece "..") rest) :up - piece))) + piece))) (name-and-type (let* ((end (first (last components))) (dot (position #\. end :from-end t))) @@ -273,18 +273,18 @@ (unless directory (go :done)) :subdir (let ((piece (pop directory))) - (typecase piece + (typecase piece ((member :up) (write-string ".." s)) (string (write-string piece s)) - (t (error "ungood piece in NATIVE-NAMESTRING: ~S" piece)))) + (t (error "ungood piece in NATIVE-NAMESTRING: ~S" piece))) + (when (or directory name type) + (write-char #\\ s))) (when directory - (write-char #\\ s) (go :subdir)) :done) (when name (unless (stringp name) (error "non-STRING name in NATIVE-NAMESTRING: ~S" name)) - (write-char #\\ s) (write-string name s) (when type (unless (stringp type) @@ -346,3 +346,93 @@ (strings ".") (strings (unparse-unix-piece pathname-type)))) (apply #'concatenate 'simple-string (strings))))) + +;; FIXME: This has been converted rather blindly from the Unix +;; version, with no reference to any Windows docs what so ever. +(defun simplify-win32-namestring (src) + (declare (type simple-string src)) + (let* ((src-len (length src)) + (dst (make-string src-len :element-type 'character)) + (dst-len 0) + (dots 0) + (last-slash nil)) + (flet ((deposit (char) + (setf (schar dst dst-len) char) + (incf dst-len)) + (slashp (char) + (find char "\\/"))) + (dotimes (src-index src-len) + (let ((char (schar src src-index))) + (cond ((char= char #\.) + (when dots + (incf dots)) + (deposit char)) + ((slashp char) + (case dots + (0 + ;; either ``/...' or ``...//...' + (unless last-slash + (setf last-slash dst-len) + (deposit char))) + (1 + ;; either ``./...'' or ``..././...'' + (decf dst-len)) + (2 + ;; We've found .. + (cond + ((and last-slash (not (zerop last-slash))) + ;; There is something before this .. + (let ((prev-prev-slash + (position-if #'slashp dst :end last-slash :from-end t))) + (cond ((and (= (+ (or prev-prev-slash 0) 2) + last-slash) + (char= (schar dst (- last-slash 2)) #\.) + (char= (schar dst (1- last-slash)) #\.)) + ;; The something before this .. is another .. + (deposit char) + (setf last-slash dst-len)) + (t + ;; The something is some directory or other. + (setf dst-len + (if prev-prev-slash + (1+ prev-prev-slash) + 0)) + (setf last-slash prev-prev-slash))))) + (t + ;; There is nothing before this .., so we need to keep it + (setf last-slash dst-len) + (deposit char)))) + (t + ;; something other than a dot between slashes + (setf last-slash dst-len) + (deposit char))) + (setf dots 0)) + (t + (setf dots nil) + (setf (schar dst dst-len) char) + (incf dst-len))))) + ;; ...finish off + (when (and last-slash (not (zerop last-slash))) + (case dots + (1 + ;; We've got ``foobar/.'' + (decf dst-len)) + (2 + ;; We've got ``foobar/..'' + (unless (and (>= last-slash 2) + (char= (schar dst (1- last-slash)) #\.) + (char= (schar dst (- last-slash 2)) #\.) + (or (= last-slash 2) + (slashp (schar dst (- last-slash 3))))) + (let ((prev-prev-slash + (position-if #'slashp dst :end last-slash :from-end t))) + (if prev-prev-slash + (setf dst-len (1+ prev-prev-slash)) + (return-from simplify-win32-namestring + (coerce ".\\" 'simple-string))))))))) + (cond ((zerop dst-len) + ".\\") + ((= dst-len src-len) + dst) + (t + (subseq dst 0 dst-len))))) diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp index e9abce8..6e12676 100644 --- a/tests/filesys.pure.lisp +++ b/tests/filesys.pure.lisp @@ -32,7 +32,8 @@ ;; We know a little bit about the structure of this result; ;; let's test to make sure that this test file is in it. (assert (find-if (lambda (pathname) - (search "tests/filesys.pure.lisp" + (search #-win32 "tests/filesys.pure.lisp" + #+win32 "tests\\filesys.pure.lisp" (namestring pathname))) dir))) ;;; In sbcl-0.9.7 DIRECTORY failed on pathnames with character-set @@ -85,34 +86,45 @@ (assert (typep (nth-value 1 (ignore-errors (file-length *terminal-io*))) 'type-error)) +;;; A few cases Windows does have enough marbles to pass right now +#+win32 +(progn + (assert (equal "C:\\FOO" (native-namestring "C:\\FOO"))) + (assert (equal "C:\\FOO" (native-namestring "C:/FOO"))) + (assert (equal "C:\\FOO\\BAR" (native-namestring "C:\\FOO\\BAR"))) + ;; FIXME: Other platforms don't do this: either fix Windows + ;; so that it works even with the same logic others use, or + ;; make this official. (Currently just a kludge.) + (assert (equal "C:\\FOO\\BAR" (native-namestring "C:\\FOO\\BAR\\")))) + ;;; Test for NATIVE-PATHNAME / NATIVE-NAMESTRING stuff ;;; ;;; given only safe characters in the namestring, NATIVE-PATHNAME will ;;; never error, and NATIVE-NAMESTRING on the result will return the ;;; original namestring. -(let ((safe-chars - ;; for WIN32, we might want to remove #\: here - (coerce - (cons #\Newline - (loop for x from 32 to 127 collect (code-char x))) - 'simple-base-string)) - (tricky-sequences #("/../" "../" "/.." "." "/." "./" "/./" - "[]" "*" "**" "/**" "**/" "/**/" "?" - "\\*" "\\[]" "\\?" "\\*\\*" "*\\*"))) - (loop repeat 1000 - for length = (random 32) - for native-namestring = (coerce - (loop repeat length - collect - (char safe-chars - (random (length safe-chars)))) - 'simple-base-string) - for pathname = (native-pathname native-namestring) - for nnn = (native-namestring pathname) - do (assert (string= nnn native-namestring))) - (loop repeat 1000 - for native-namestring = (with-output-to-string (s) - (loop +(with-test (:name :random-native-namestrings) + (let ((safe-chars + (coerce + (cons #\Newline + (loop for x from 32 to 127 collect (code-char x))) + 'simple-base-string)) + (tricky-sequences #("/../" "../" "/.." "." "/." "./" "/./" + "[]" "*" "**" "/**" "**/" "/**/" "?" + "\\*" "\\[]" "\\?" "\\*\\*" "*\\*"))) + (loop repeat 1000 + for length = (random 32) + for native-namestring = (coerce + (loop repeat length + collect + (char safe-chars + (random (length safe-chars)))) + 'simple-base-string) + for pathname = (native-pathname native-namestring) + for nnn = (native-namestring pathname) + do (assert (string= nnn native-namestring))) + (loop repeat 1000 + for native-namestring = (with-output-to-string (s) + (loop (let ((r (random 1.0))) (cond ((< r 1/20) (return)) @@ -126,6 +138,6 @@ (random (length tricky-sequences))) s)))))) - for pathname = (native-pathname native-namestring) - for nnn = (native-namestring pathname) - do (assert (string= nnn native-namestring)))) + for pathname = (native-pathname native-namestring) + for tricky-nnn = (native-namestring pathname) + do (assert (string= tricky-nnn native-namestring))))) diff --git a/tests/interface.pure.lisp b/tests/interface.pure.lisp index df8ee36..285ddcb 100644 --- a/tests/interface.pure.lisp +++ b/tests/interface.pure.lisp @@ -57,10 +57,11 @@ (assert (not (special-operator-p 'declare))) ;;; WITH-TIMEOUT should accept more than one form in its body. -(handler-bind ((sb-ext:timeout #'continue)) - (sb-ext:with-timeout 3 - (sleep 2) - (sleep 2))) +(with-test (:name :with-timeout-forms) + (handler-bind ((sb-ext:timeout #'continue)) + (sb-ext:with-timeout 3 + (sleep 2) + (sleep 2)))) ;;; DOCUMENTATION should return nil, not signal slot-unbound (documentation 'fixnum 'type) diff --git a/version.lisp-expr b/version.lisp-expr index f81f8c7..f65bd72 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.18.8" +"0.9.18.9"