X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Falien.impure.lisp;h=98e88f24fb30a534d67b94392e2a4fb271dbb293;hb=35f68f481cbea35889d2488c476cbc28898e82f4;hp=f97e73c7a7bb11892c075453e06feeb0c8a4e8e2;hpb=1100ef9f0598e4b72c1dacaae530ca6a93de706b;p=sbcl.git

diff --git a/tests/alien.impure.lisp b/tests/alien.impure.lisp
index f97e73c..98e88f2 100644
--- a/tests/alien.impure.lisp
+++ b/tests/alien.impure.lisp
@@ -264,8 +264,7 @@
     ((foo (unsigned 32)))
   foo)
 
-#+(or x86-64 x86)
-(with-test (:name bug-316325)
+(with-test (:name bug-316325 :skipped-on '(not (or :x86-64 :x86)))
   ;; This test works by defining a callback function that provides an
   ;; identity transform over a full-width machine word, then calling
   ;; it as if it returned a narrower type and checking to see if any
@@ -305,7 +304,7 @@
                                            "execv"))
                     (values (alien-funcall sys-execv1 program argv)))))
     (compiler-note (n)
-      (error n))))
+      (error "bad note: ~A" n))))
 
 (with-test (:name :bug-721087)
   (assert (typep nil '(alien c-string)))
@@ -325,4 +324,90 @@
     (assert (equal "This comes from lisp!" (cast alien c-string)))
     (free-alien alien)))
 
+(with-test (:name :malloc-failure)
+  (assert (eq :enomem
+              (handler-case
+                  (loop repeat 128
+                        collect (sb-alien:make-alien char (1- array-total-size-limit)))
+                (storage-condition ()
+                  :enomem)))))
+
+(with-test (:name :bug-985505)
+  ;; Check that correct octets are reported for a c-string-decoding error.
+  (assert
+   (eq :unibyte
+       (handler-case
+           (let ((c-string (coerce #(70 111 195 182 0)
+                                   '(vector (unsigned-byte 8)))))
+             (sb-sys:with-pinned-objects (c-string)
+               (sb-alien::c-string-to-string (sb-sys:vector-sap c-string)
+                                             :ascii 'character)))
+         (sb-int:c-string-decoding-error (e)
+           (assert (equalp #(195) (sb-int:character-decoding-error-octets e)))
+           :unibyte))))
+  (assert
+   (eq :multibyte-4
+       (handler-case
+           ;; KLUDGE, sort of.
+           ;;
+           ;; C-STRING decoding doesn't know how long the string is, and since this
+           ;; looks like a 4-byte sequence, it will grab 4 octets off the end.
+           ;;
+           ;; So we pad the vector for safety's sake.
+           (let ((c-string (coerce #(70 111 246 0 0 0)
+                                   '(vector (unsigned-byte 8)))))
+             (sb-sys:with-pinned-objects (c-string)
+               (sb-alien::c-string-to-string (sb-sys:vector-sap c-string)
+                                             :utf-8 'character)))
+         (sb-int:c-string-decoding-error (e)
+           (assert (equalp #(246 0 0 0)
+                           (sb-int:character-decoding-error-octets e)))
+           :multibyte-4))))
+  (assert
+   (eq :multibyte-2
+       (handler-case
+           (let ((c-string (coerce #(70 195 1 182 195 182 0) '(vector (unsigned-byte 8)))))
+             (sb-sys:with-pinned-objects (c-string)
+               (sb-alien::c-string-to-string (sb-sys:vector-sap c-string)
+                                             :utf-8 'character)))
+         (sb-int:c-string-decoding-error (e)
+           (assert (equalp #(195 1)
+                           (sb-int:character-decoding-error-octets e)))
+           :multibyte-2)))))
+
+(with-test (:name :stream-to-c-string-decoding-restart-leakage)
+  ;; Restarts for stream decoding errors didn't use to be associated with
+  ;; their conditions, so they could get confused with c-string decoding errors.
+  (assert (eq :nesting-ok
+              (catch 'out
+                (handler-bind ((sb-int:character-decoding-error
+                                 (lambda (stream-condition)
+                                   (handler-bind ((sb-int:character-decoding-error
+                                                    (lambda (c-string-condition)
+                                                      (throw 'out
+                                                        (if (find-restart
+                                                             'sb-impl::input-replacement
+                                                             c-string-condition)
+                                                            :bad-restart
+                                                            :nesting-ok)))))
+                                     (let ((c-string (coerce #(70 195 1 182 195 182 0)
+                                                             '(vector (unsigned-byte 8)))))
+                                       (sb-sys:with-pinned-objects (c-string)
+                                         (sb-alien::c-string-to-string
+                                          (sb-sys:vector-sap c-string)
+                                          :utf-8 'character)))))))
+                  (let ((namestring "alien.impure.tmp"))
+                    (unwind-protect
+                         (progn
+                           (with-open-file (f namestring
+                                              :element-type '(unsigned-byte 8)
+                                              :direction :output
+                                              :if-exists :supersede)
+                             (dolist (b '(70 195 1 182 195 182 0))
+                               (write-byte b f)))
+                           (with-open-file (f namestring
+                                              :external-format :utf-8)
+                             (read-line f)))
+                      (delete-file namestring))))))))
+
 ;;; success