common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Fix interpreted calls to c-string-to-string

Browse source
This commit is contained in:
Stas Boukarev 2026-06-17 18:35:12 +03:00
parent ff7e3a1ca6
commit 7ee71e8a92
4 changed files with 16 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
src/code/c-call.lisp
View file

@ -99,7 +99,9 @@
;; If we need to check for non-ascii data in the input, we
;; might as well go through the usual external-format machinery
;; instead of rewriting another version of it.
,(let ((conv `(c-string-to-string
,(let ((conv `(,(if (sb-c::compiling-p)
'c-string-to-string
'c-string-to-string-boxed-sap)
,alien
(c-string-external-format ,type)
',(alien-c-string-type-element-type type))))

3
src/code/fd-stream.lisp
View file

@ -934,6 +934,9 @@
(let ((external-format (get-external-format-or-lose external-format)))
(funcall (ef-read-c-string-fun external-format) sap element-type)))))
(defun sb-alien::c-string-to-string-boxed-sap (sap external-format element-type)
(sb-alien::c-string-to-string sap external-format element-type))
(defun get-external-format-or-lose (external-format)
(or (get-external-format external-format)
(error "Undefined external-format: ~S" external-format)))

4
src/compiler/ir1util.lisp
View file

@ -4054,7 +4054,9 @@ is :ANY, the function name is not checked."
*lexenv*)))
t))
(defun compiling-p (environment)
(defun compiling-p (&optional (environment
(and (boundp '*lexenv*)
(symbol-value '*lexenv*))))
(and (boundp 'sb-c:*compilation*)
environment
#+sb-fasteval

14
tests/alien.impure.lisp
View file

@ -373,8 +373,8 @@
(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-alien::c-string-to-string-boxed-sap (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))))
@ -390,8 +390,8 @@
(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-alien::c-string-to-string-boxed-sap (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)))
@ -401,8 +401,8 @@
(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-alien::c-string-to-string-boxed-sap (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)))
@ -427,7 +427,7 @@
(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-alien::c-string-to-string-boxed-sap
(sb-sys:vector-sap c-string)
:utf-8 'character)))))))
(let ((namestring (scratch-file-name)))