X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Fexternal-format.impure.lisp;h=430078ba5961b88a716d57b62d5b67f6777d8b41;hb=54b330585ed41edeb93a289f0e59aec67fa9ded9;hp=137353825f71385217f5e82a1414ff31cec59264;hpb=68ea71d0f020f2726e3c56c1ec491d0af734b3a4;p=sbcl.git diff --git a/tests/external-format.impure.lisp b/tests/external-format.impure.lisp index 1373538..430078b 100644 --- a/tests/external-format.impure.lisp +++ b/tests/external-format.impure.lisp @@ -280,4 +280,45 @@ (assert (char= char new-char))))) (values))) +;;; External format support in SB-ALIEN + +(with-test (:name (:sb-alien :vanilla)) + (define-alien-routine strdup c-string (str c-string)) + (assert (equal "foo" (strdup "foo")))) + +(with-test (:name (:sb-alien :utf-8 :utf-8)) + (define-alien-routine strdup (c-string :external-format :utf-8) + (str (c-string :external-format :utf-8))) + (assert (equal "foo" (strdup "foo")))) + +(with-test (:name (:sb-alien :latin-1 :utf-8)) + (define-alien-routine strdup (c-string :external-format :latin-1) + (str (c-string :external-format :utf-8))) + (assert (= (length (strdup (string (code-char 246)))) + 2))) + +(with-test (:name (:sb-alien :utf-8 :latin-1)) + (define-alien-routine strdup (c-string :external-format :utf-8) + (str (c-string :external-format :latin-1))) + (assert (equal (string (code-char 228)) + (strdup (concatenate 'string + (list (code-char 195)) + (list (code-char 164))))))) + +(with-test (:name (:sb-alien :ebcdic :ebcdic)) + (define-alien-routine strdup (c-string :external-format :ebcdic-us) + (str (c-string :external-format :ebcdic-us))) + (assert (equal "foo" (strdup "foo")))) + +(with-test (:name (:sb-alien :latin-1 :ebcdic)) + (define-alien-routine strdup (c-string :external-format :latin-1) + (str (c-string :external-format :ebcdic-us))) + (assert (not (equal "foo" (strdup "foo"))))) + +(with-test (:name (:sb-alien :simple-base-string)) + (define-alien-routine strdup (c-string :external-format :ebcdic-us + :element-type base-char) + (str (c-string :external-format :ebcdic-us))) + (assert (typep (strdup "foo") 'simple-base-string))) + ;;;; success