X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fexternal-format.impure.lisp;h=430078ba5961b88a716d57b62d5b67f6777d8b41;hb=bb1ead258cdbd5cbd0fe25e16cb6a201873b630b;hp=137353825f71385217f5e82a1414ff31cec59264;hpb=57d893458e9cb6fdc902d78f69fc3e4f362fe778;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