From b3e3fbe7d381147fccc8a3027cb6fae923e57d13 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Wed, 31 Aug 2005 14:12:37 +0000 Subject: [PATCH] 0.9.4.17: Fix a some policy violations that have crept in: * Canonicalize whitespace * Change genesis to output C code with canonical whitespace * Kill some gcc warnings * Change genesis to explicitly mark large integer literals as unsigned Small test framework change: * Unexpected successes are reported, but do not cause a failure return code for the whole test suite. There are some non-deterministic tests that don't always fail. --- src/code/external-formats/enc-cyr.lisp | 34 ++++---- src/code/external-formats/enc-dos.lisp | 140 ++++++++++++++++---------------- src/code/external-formats/enc-iso.lisp | 120 +++++++++++++-------------- src/code/external-formats/enc-win.lisp | 90 ++++++++++---------- src/compiler/generic/genesis.lisp | 6 +- src/pcl/boot.lisp | 6 +- src/runtime/backtrace.c | 19 ++--- src/runtime/gencgc.c | 2 +- src/runtime/mips-arch.c | 2 +- tests/float.impure.lisp | 4 +- tests/run-tests.lisp | 13 +-- tests/test-util.lisp | 4 +- version.lisp-expr | 2 +- 13 files changed, 222 insertions(+), 220 deletions(-) diff --git a/src/code/external-formats/enc-cyr.lisp b/src/code/external-formats/enc-cyr.lisp index 637ea96..0cfa0e3 100644 --- a/src/code/external-formats/enc-cyr.lisp +++ b/src/code/external-formats/enc-cyr.lisp @@ -32,7 +32,7 @@ (#x9C #x00B0) ; DEGREE SIGN (#x9D #x00B2) ; SUPERSCRIPT TWO (#x9E #x00B7) ; MIDDLE DOT - (#x9F #x00F7) ; DIVISION SIGN + (#x9F #x00F7) ; DIVISION SIGN (#xA0 #x2550) ; BOX DRAWINGS DOUBLE HORIZONTAL (#xA1 #x2551) ; BOX DRAWINGS DOUBLE VERTICAL (#xA2 #x2552) ; BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE @@ -64,7 +64,7 @@ (#xBC #x256A) ; BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE (#xBD #x256B) ; BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE (#xBE #x256C) ; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL - (#xBF #x00A9) ; COPYRIGHT SIGN + (#xBF #x00A9) ; COPYRIGHT SIGN (#xC0 #x044E) ; CYRILLIC SMALL LETTER YU (#xC1 #x0430) ; CYRILLIC SMALL LETTER A (#xC2 #x0431) ; CYRILLIC SMALL LETTER BE @@ -134,14 +134,14 @@ (declaim (inline get-koi8-r-bytes)) (defun get-koi8-r-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :koi8-r string pos end)) (defun string->koi8-r (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-koi8-r-bytes null-padding))) (defmacro define-koi8-r->string* (accessor type) @@ -149,7 +149,7 @@ (let ((name (make-od-name 'koi8-r->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-koi8-r->string*) @@ -309,14 +309,14 @@ (declaim (inline get-koi8-u-bytes)) (defun get-koi8-u-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :koi8-u string pos end)) (defun string->koi8-u (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-koi8-u-bytes null-padding))) (defmacro define-koi8-u->string* (accessor type) @@ -324,7 +324,7 @@ (let ((name (make-od-name 'koi8-u->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-koi8-u->string*) @@ -479,14 +479,14 @@ (declaim (inline get-x-mac-cyrillic-bytes)) (defun get-x-mac-cyrillic-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :x-mac-cyrillic string pos end)) (defun string->x-mac-cyrillic (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-x-mac-cyrillic-bytes null-padding))) (defmacro define-x-mac-cyrillic->string* (accessor type) @@ -494,7 +494,7 @@ (let ((name (make-od-name 'x-mac-cyrillic->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-x-mac-cyrillic->string*) diff --git a/src/code/external-formats/enc-dos.lisp b/src/code/external-formats/enc-dos.lisp index 2755770..7ca0963 100644 --- a/src/code/external-formats/enc-dos.lisp +++ b/src/code/external-formats/enc-dos.lisp @@ -134,14 +134,14 @@ (declaim (inline get-cp437-bytes)) (defun get-cp437-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp437 string pos end)) (defun string->cp437 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp437-bytes null-padding))) (defmacro define-cp437->string* (accessor type) @@ -149,7 +149,7 @@ (let ((name (make-od-name 'cp437->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp437->string*) @@ -309,14 +309,14 @@ (declaim (inline get-cp850-bytes)) (defun get-cp850-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp850 string pos end)) (defun string->cp850 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp850-bytes null-padding))) (defmacro define-cp850->string* (accessor type) @@ -324,7 +324,7 @@ (let ((name (make-od-name 'cp850->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp850->string*) @@ -484,14 +484,14 @@ (declaim (inline get-cp852-bytes)) (defun get-cp852-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp852 string pos end)) (defun string->cp852 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp852-bytes null-padding))) (defmacro define-cp852->string* (accessor type) @@ -499,7 +499,7 @@ (let ((name (make-od-name 'cp852->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp852->string*) @@ -659,14 +659,14 @@ (declaim (inline get-cp855-bytes)) (defun get-cp855-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp855 string pos end)) (defun string->cp855 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp855-bytes null-padding))) (defmacro define-cp855->string* (accessor type) @@ -674,7 +674,7 @@ (let ((name (make-od-name 'cp855->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp855->string*) @@ -833,14 +833,14 @@ (declaim (inline get-cp857-bytes)) (defun get-cp857-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp857 string pos end)) (defun string->cp857 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp857-bytes null-padding))) (defmacro define-cp857->string* (accessor type) @@ -848,7 +848,7 @@ (let ((name (make-od-name 'cp857->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp857->string*) @@ -1008,14 +1008,14 @@ (declaim (inline get-cp860-bytes)) (defun get-cp860-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp860 string pos end)) (defun string->cp860 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp860-bytes null-padding))) (defmacro define-cp860->string* (accessor type) @@ -1023,7 +1023,7 @@ (let ((name (make-od-name 'cp860->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp860->string*) @@ -1183,14 +1183,14 @@ (declaim (inline get-cp861-bytes)) (defun get-cp861-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp861 string pos end)) (defun string->cp861 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp861-bytes null-padding))) (defmacro define-cp861->string* (accessor type) @@ -1198,7 +1198,7 @@ (let ((name (make-od-name 'cp861->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp861->string*) @@ -1358,14 +1358,14 @@ (declaim (inline get-cp862-bytes)) (defun get-cp862-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp862 string pos end)) (defun string->cp862 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp862-bytes null-padding))) (defmacro define-cp862->string* (accessor type) @@ -1373,7 +1373,7 @@ (let ((name (make-od-name 'cp862->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp862->string*) @@ -1533,14 +1533,14 @@ (declaim (inline get-cp863-bytes)) (defun get-cp863-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp863 string pos end)) (defun string->cp863 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp863-bytes null-padding))) (defmacro define-cp863->string* (accessor type) @@ -1548,7 +1548,7 @@ (let ((name (make-od-name 'cp863->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp863->string*) @@ -1705,14 +1705,14 @@ (declaim (inline get-cp864-bytes)) (defun get-cp864-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp864 string pos end)) (defun string->cp864 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp864-bytes null-padding))) (defmacro define-cp864->string* (accessor type) @@ -1720,7 +1720,7 @@ (let ((name (make-od-name 'cp864->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp864->string*) @@ -1880,14 +1880,14 @@ (declaim (inline get-cp865-bytes)) (defun get-cp865-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp865 string pos end)) (defun string->cp865 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp865-bytes null-padding))) (defmacro define-cp865->string* (accessor type) @@ -1895,7 +1895,7 @@ (let ((name (make-od-name 'cp865->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp865->string*) @@ -2055,14 +2055,14 @@ (declaim (inline get-cp866-bytes)) (defun get-cp866-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp866 string pos end)) (defun string->cp866 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp866-bytes null-padding))) (defmacro define-cp866->string* (accessor type) @@ -2070,7 +2070,7 @@ (let ((name (make-od-name 'cp866->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp866->string*) @@ -2230,14 +2230,14 @@ (declaim (inline get-cp869-bytes)) (defun get-cp869-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp869 string pos end)) (defun string->cp869 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp869-bytes null-padding))) (defmacro define-cp869->string* (accessor type) @@ -2245,7 +2245,7 @@ (let ((name (make-od-name 'cp869->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp869->string*) @@ -2404,14 +2404,14 @@ (declaim (inline get-cp874-bytes)) (defun get-cp874-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp874 string pos end)) (defun string->cp874 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp874-bytes null-padding))) (defmacro define-cp874->string* (accessor type) @@ -2419,7 +2419,7 @@ (let ((name (make-od-name 'cp874->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp874->string*) diff --git a/src/code/external-formats/enc-iso.lisp b/src/code/external-formats/enc-iso.lisp index 0fb5cbe..4c60368 100644 --- a/src/code/external-formats/enc-iso.lisp +++ b/src/code/external-formats/enc-iso.lisp @@ -63,14 +63,14 @@ (declaim (inline get-iso-8859-2-bytes)) (defun get-iso-8859-2-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :iso-8859-2 string pos end)) (defun string->iso-8859-2 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-2-bytes null-padding))) (defmacro define-iso-8859-2->string* (accessor type) @@ -78,7 +78,7 @@ (let ((name (make-od-name 'iso-8859-2->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-iso-8859-2->string*) @@ -145,14 +145,14 @@ (declaim (inline get-iso-8859-3-bytes)) (defun get-iso-8859-3-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :iso-8859-3 string pos end)) (defun string->iso-8859-3 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-3-bytes null-padding))) (defmacro define-iso-8859-3->string* (accessor type) @@ -160,7 +160,7 @@ (let ((name (make-od-name 'iso-8859-3->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-iso-8859-3->string*) @@ -242,14 +242,14 @@ (declaim (inline get-iso-8859-4-bytes)) (defun get-iso-8859-4-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :iso-8859-4 string pos end)) (defun string->iso-8859-4 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-4-bytes null-padding))) (defmacro define-iso-8859-4->string* (accessor type) @@ -257,7 +257,7 @@ (let ((name (make-od-name 'iso-8859-4->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-iso-8859-4->string*) @@ -383,14 +383,14 @@ (declaim (inline get-iso-8859-5-bytes)) (defun get-iso-8859-5-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :iso-8859-5 string pos end)) (defun string->iso-8859-5 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-5-bytes null-padding))) (defmacro define-iso-8859-5->string* (accessor type) @@ -398,7 +398,7 @@ (let ((name (make-od-name 'iso-8859-5->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-iso-8859-5->string*) @@ -523,14 +523,14 @@ (declaim (inline get-iso-8859-6-bytes)) (defun get-iso-8859-6-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :iso-8859-6 string pos end)) (defun string->iso-8859-6 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-6-bytes null-padding))) (defmacro define-iso-8859-6->string* (accessor type) @@ -538,7 +538,7 @@ (let ((name (make-od-name 'iso-8859-6->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-iso-8859-6->string*) @@ -650,14 +650,14 @@ (declaim (inline get-iso-8859-7-bytes)) (defun get-iso-8859-7-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :iso-8859-7 string pos end)) (defun string->iso-8859-7 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-7-bytes null-padding))) (defmacro define-iso-8859-7->string* (accessor type) @@ -665,7 +665,7 @@ (let ((name (make-od-name 'iso-8859-7->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-iso-8859-7->string*) @@ -766,14 +766,14 @@ (declaim (inline get-iso-8859-8-bytes)) (defun get-iso-8859-8-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :iso-8859-8 string pos end)) (defun string->iso-8859-8 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-8-bytes null-padding))) (defmacro define-iso-8859-8->string* (accessor type) @@ -781,7 +781,7 @@ (let ((name (make-od-name 'iso-8859-8->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-iso-8859-8->string*) @@ -819,14 +819,14 @@ (declaim (inline get-iso-8859-9-bytes)) (defun get-iso-8859-9-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :iso-8859-9 string pos end)) (defun string->iso-8859-9 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-9-bytes null-padding))) (defmacro define-iso-8859-9->string* (accessor type) @@ -834,7 +834,7 @@ (let ((name (make-od-name 'iso-8859-9->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-iso-8859-9->string*) @@ -912,14 +912,14 @@ (declaim (inline get-iso-8859-10-bytes)) (defun get-iso-8859-10-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :iso-8859-10 string pos end)) (defun string->iso-8859-10 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-10-bytes null-padding))) (defmacro define-iso-8859-10->string* (accessor type) @@ -927,7 +927,7 @@ (let ((name (make-od-name 'iso-8859-10->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-iso-8859-10->string*) @@ -1054,14 +1054,14 @@ (declaim (inline get-iso-8859-11-bytes)) (defun get-iso-8859-11-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :iso-8859-11 string pos end)) (defun string->iso-8859-11 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-11-bytes null-padding))) (defmacro define-iso-8859-11->string* (accessor type) @@ -1069,7 +1069,7 @@ (let ((name (make-od-name 'iso-8859-11->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-iso-8859-11->string*) @@ -1157,14 +1157,14 @@ (declaim (inline get-iso-8859-13-bytes)) (defun get-iso-8859-13-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :iso-8859-13 string pos end)) (defun string->iso-8859-13 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-13-bytes null-padding))) (defmacro define-iso-8859-13->string* (accessor type) @@ -1172,7 +1172,7 @@ (let ((name (make-od-name 'iso-8859-13->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-iso-8859-13->string*) @@ -1235,14 +1235,14 @@ (declaim (inline get-iso-8859-14-bytes)) (defun get-iso-8859-14-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :iso-8859-14 string pos end)) (defun string->iso-8859-14 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-14-bytes null-padding))) (defmacro define-iso-8859-14->string* (accessor type) @@ -1250,7 +1250,7 @@ (let ((name (make-od-name 'iso-8859-14->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-iso-8859-14->string*) diff --git a/src/code/external-formats/enc-win.lisp b/src/code/external-formats/enc-win.lisp index 94879e5..b223f01 100644 --- a/src/code/external-formats/enc-win.lisp +++ b/src/code/external-formats/enc-win.lisp @@ -85,14 +85,14 @@ (declaim (inline get-cp1250-bytes)) (defun get-cp1250-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp1250 string pos end)) (defun string->cp1250 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp1250-bytes null-padding))) (defmacro define-cp1250->string* (accessor type) @@ -100,7 +100,7 @@ (let ((name (make-od-name 'cp1250->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp1250->string*) @@ -245,14 +245,14 @@ (declaim (inline get-cp1251-bytes)) (defun get-cp1251-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp1251 string pos end)) (defun string->cp1251 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp1251-bytes null-padding))) (defmacro define-cp1251->string* (accessor type) @@ -260,7 +260,7 @@ (let ((name (make-od-name 'cp1251->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp1251->string*) @@ -324,14 +324,14 @@ (declaim (inline get-cp1252-bytes)) (defun get-cp1252-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp1252 string pos end)) (defun string->cp1252 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp1252-bytes null-padding))) (defmacro define-cp1252->string* (accessor type) @@ -339,7 +339,7 @@ (let ((name (make-od-name 'cp1252->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp1252->string*) @@ -478,14 +478,14 @@ (declaim (inline get-cp1253-bytes)) (defun get-cp1253-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp1253 string pos end)) (defun string->cp1253 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp1253-bytes null-padding))) (defmacro define-cp1253->string* (accessor type) @@ -493,7 +493,7 @@ (let ((name (make-od-name 'cp1253->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp1253->string*) @@ -563,14 +563,14 @@ (declaim (inline get-cp1254-bytes)) (defun get-cp1254-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp1254 string pos end)) (defun string->cp1254 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp1254-bytes null-padding))) (defmacro define-cp1254->string* (accessor type) @@ -578,7 +578,7 @@ (let ((name (make-od-name 'cp1254->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp1254->string*) @@ -709,14 +709,14 @@ (declaim (inline get-cp1255-bytes)) (defun get-cp1255-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp1255 string pos end)) (defun string->cp1255 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp1255-bytes null-padding))) (defmacro define-cp1255->string* (accessor type) @@ -724,7 +724,7 @@ (let ((name (make-od-name 'cp1255->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp1255->string*) @@ -841,14 +841,14 @@ (declaim (inline get-cp1256-bytes)) (defun get-cp1256-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp1256 string pos end)) (defun string->cp1256 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp1256-bytes null-padding))) (defmacro define-cp1256->string* (accessor type) @@ -856,7 +856,7 @@ (let ((name (make-od-name 'cp1256->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp1256->string*) @@ -975,14 +975,14 @@ (declaim (inline get-cp1257-bytes)) (defun get-cp1257-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp1257 string pos end)) (defun string->cp1257 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp1257-bytes null-padding))) (defmacro define-cp1257->string* (accessor type) @@ -990,7 +990,7 @@ (let ((name (make-od-name 'cp1257->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp1257->string*) @@ -1068,14 +1068,14 @@ (declaim (inline get-cp1258-bytes)) (defun get-cp1258-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) + (type simple-string string) + (type array-range pos end)) (get-latin-bytes #'identity :cp1258 string pos end)) (defun string->cp1258 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-cp1258-bytes null-padding))) (defmacro define-cp1258->string* (accessor type) @@ -1083,7 +1083,7 @@ (let ((name (make-od-name 'cp1258->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) (instantiate-octets-definition define-cp1258->string*) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 4de59b9..9dec385 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -2594,7 +2594,7 @@ core and return a descriptor to it." (dolist (line '("This is a machine-generated file. Please do not edit it by hand." "(As of sbcl-0.8.14, it came from WRITE-CONFIG-H in genesis.lisp.)" - "" + nil "This file contains low-level information about the" "internals of a particular version and configuration" "of SBCL. It is used by the C compiler to create a runtime" @@ -2602,7 +2602,7 @@ core and return a descriptor to it." "operating system's native format, which can then be used to" "load and run 'core' files, which are basically programs" "in SBCL's own format.")) - (format t " * ~A~%" line)) + (format t " *~@[ ~A~]~%" line)) (format t " */~%")) (defun write-config-h () @@ -2746,7 +2746,7 @@ core and return a descriptor to it." ((< value cutoff) "~D") (t - "LISPOBJ(~D)"))) + "LISPOBJ(~DU)"))) value) (format t " /* 0x~X */~@[ /* ~A */~]~%" value doc)))) (terpri)) diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index 7487b14..aee604a 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -1987,9 +1987,9 @@ bootstrapping. (let ((method-class (getf ,all-keys :method-class '.shes-not-there.))) (unless (eq method-class '.shes-not-there.) (setf (getf ,all-keys :method-class) - (cond ((classp method-class) - method-class) - (t (find-class method-class t ,env)))))))) + (cond ((classp method-class) + method-class) + (t (find-class method-class t ,env)))))))) (defun real-ensure-gf-using-class--generic-function (existing diff --git a/src/runtime/backtrace.c b/src/runtime/backtrace.c index e4784a2..624ffcf 100644 --- a/src/runtime/backtrace.c +++ b/src/runtime/backtrace.c @@ -279,8 +279,8 @@ static int stack_pointer_p (void *p) { return (p < (void *) arch_os_get_current_thread()->control_stack_end - && p > (void *) &p - && (((unsigned long) p) & 3) == 0); + && p > (void *) &p + && (((unsigned long) p) & 3) == 0); } static int @@ -307,11 +307,11 @@ x86_call_context (void *fp, void **ra, void **ocfp) lisp_ra = *((void **) fp - 2); lisp_valid_p = (lisp_ocfp > fp - && stack_pointer_p(lisp_ocfp) - && ra_pointer_p(lisp_ra)); + && stack_pointer_p(lisp_ocfp) + && ra_pointer_p(lisp_ra)); c_valid_p = (c_ocfp > fp - && stack_pointer_p(c_ocfp) - && ra_pointer_p(c_ra)); + && stack_pointer_p(c_ocfp) + && ra_pointer_p(c_ra)); if (lisp_valid_p && c_valid_p) { void *lisp_path_fp; @@ -372,7 +372,7 @@ debug_function_from_pc (struct code* code, void *pc) for (i = 1;; i += 2) { unsigned next_pc; - + if (i == len) return ((struct compiled_debug_fun *) native_pointer(v->data[i - 1])); @@ -426,7 +426,6 @@ print_entry_name (lispobj name) printf("\"%s\"", (char *) string->data); #ifdef SIMPLE_CHARACTER_STRING_WIDETAG } else if (widetag_of(*object) == SIMPLE_CHARACTER_STRING_WIDETAG) { - struct vector *string = (struct vector *) object; printf(""); /* FIXME */ #endif } else @@ -443,7 +442,7 @@ print_entry_points (struct code *code) while (function != NIL) { struct simple_fun *header = (struct simple_fun *) native_pointer(function); print_entry_name(header->name); - + function = header->next; if (function != NIL) printf (", "); @@ -468,7 +467,7 @@ backtrace(int nframes) lispobj *p; void *ra; void *next_fp; - + if (!x86_call_context(fp, &ra, &next_fp)) break; diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index c2dd4ba..6b2f6f7 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -1407,7 +1407,7 @@ sniff_code_object(struct code *code, unsigned displacement) { long nheader_words, ncode_words, nwords; void *p; - void *constants_start_addr, *constants_end_addr; + void *constants_start_addr = NULL, *constants_end_addr; void *code_start_addr, *code_end_addr; int fixup_found = 0; diff --git a/src/runtime/mips-arch.c b/src/runtime/mips-arch.c index 0e7483d..bfcff9c 100644 --- a/src/runtime/mips-arch.c +++ b/src/runtime/mips-arch.c @@ -108,7 +108,7 @@ emulate_branch(os_context_t *context, unsigned int inst) *os_context_register_addr(context, 31) = os_context_pc(context) + 4; break; - default: /* conditional branches/traps for > MIPS I, ignore for now. */ + default: /* conditional branches/traps for > MIPS I, ignore for now. */ break; } break; diff --git a/tests/float.impure.lisp b/tests/float.impure.lisp index aaf7eb8..04609a4 100644 --- a/tests/float.impure.lisp +++ b/tests/float.impure.lisp @@ -114,8 +114,8 @@ (assert (= (test 1.0d0) 2.0d0)) -(deftype myarraytype (&optional (length '*)) +(deftype myarraytype (&optional (length '*)) `(simple-array double-float (,length))) (defun new-pu-label-from-pu-labels (array) - (setf (aref (the myarraytype array) 0) + (setf (aref (the myarraytype array) 0) sb-ext:double-float-positive-infinity)) diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp index 32f7bb9..cc1adc6 100644 --- a/tests/run-tests.lisp +++ b/tests/run-tests.lisp @@ -43,7 +43,7 @@ (format t "Finished running tests.~%") (cond (*all-failures* (format t "Status:~%") - (dolist (fail (reverse *all-failures*)) + (dolist (fail (reverse *all-failures*)) (cond ((eq (car fail) :unhandled-error) (format t " ~20a ~a~%" "Unhandled error" @@ -79,7 +79,7 @@ (when *break-on-error* (test-util:really-invoke-debugger error)))))) (append-failures))) - + (defun impure-runner (files test-fun) (format t "// Running impure tests (~a)~%" test-fun) (let ((*package* (find-package :cl-user))) @@ -115,7 +115,10 @@ (setf *all-failures* (append failures *all-failures*))) (defun unexpected-failures () - (remove-if (lambda (x) (eq (car x) :expected-failure)) *all-failures*)) + (remove-if (lambda (x) + (or (eq (car x) :expected-failure) + (eq (car x) :unexpected-success))) + *all-failures*)) (defun setup-cl-user () (use-package :test-util) @@ -135,9 +138,9 @@ (defun sh-test (file) ;; What? No SB-POSIX:EXECV? - (let ((process (sb-ext:run-program "/bin/sh" + (let ((process (sb-ext:run-program "/bin/sh" (list (namestring file)) - :output *error-output*))) + :output *error-output*))) (sb-ext:quit :unix-status (process-exit-code process)))) (defun accept-test-file (file) diff --git a/tests/test-util.lisp b/tests/test-util.lisp index 00a986d..8ed24c8 100644 --- a/tests/test-util.lisp +++ b/tests/test-util.lisp @@ -24,7 +24,7 @@ (fail-test :unexpected-failure ',name error))))) (defun report-test-status () - (with-standard-io-syntax + (with-standard-io-syntax (with-open-file (stream "test-status.lisp-expr" :direction :output :if-exists :supersede) @@ -36,7 +36,7 @@ (setf *test-count* 0)) (incf *test-count*)) -(defun fail-test (type test-name condition) +(defun fail-test (type test-name condition) (push (list type *test-file* (or test-name *test-count*)) *failures*) (when (or (and *break-on-failure* diff --git a/version.lisp-expr b/version.lisp-expr index 130b2e6..07ccc54 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.4.16" +"0.9.4.17" -- 1.7.10.4