[prev in list] [next in list] [prev in thread] [next in thread]
List: sbcl-commits
Subject: [Sbcl-commits] master: correct octets in c-string decoding errors
From: "Nikodemus Siivola" <demoss () users ! sourceforge ! net>
Date: 2012-04-19 17:20:35
Message-ID: E1SKv27-00026s-Bk () sfs-ml-3 ! v29 ! ch3 ! sourceforge ! com
[Download RAW message or body]
The branch "master" has been updated in SBCL:
via 3f3033a6c0ddf0af8dd1b5a17c2a4b82ea59b94f (commit)
from 37b93fe46f304244d1c69c06b82a22252e393630 (commit)
- Log -----------------------------------------------------------------
commit 3f3033a6c0ddf0af8dd1b5a17c2a4b82ea59b94f
Author: Nikodemus Siivola <nikodemus@random-state.net>
Date: Thu Apr 19 13:41:28 2012 +0300
correct octets in c-string decoding errors
Also add SAP-REF-OCTETS for grabbing a vector of bytes from
memory. We'll need it elsewhere as well.
Fixes lp#985505
---
NEWS | 2 ++
package-data-list.lisp-expr | 1 +
src/code/fd-stream.lisp | 11 ++++++-----
src/code/target-sap.lisp | 8 ++++++++
tests/alien.impure.lisp | 37 +++++++++++++++++++++++++++++++++++++
5 files changed, 54 insertions(+), 5 deletions(-)
diff --git a/NEWS b/NEWS
index 1c5d75f..678758b 100644
--- a/NEWS
+++ b/NEWS
@@ -24,6 +24,8 @@ changes relative to sbcl-1.0.56:
* bug fix: fix miscompilation of some logand forms with large constant
arguments. (lp#974406)
* bug fix: account for funcallable-instance objects properly in ROOM.
+ * bug fix: incorrect octets reported for c-string decoding errors.
+ (lp#985505)
* documentation:
** improved docstrings: REPLACE (lp#965592)
diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 09532f1..2ef025b 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -2376,6 +2376,7 @@ SB-KERNEL) have been undone, but probably more remain."
"SAP-REF-16" "SAP-REF-32" "SAP-REF-64" "SAP-REF-WORD"
"SAP-REF-8"
"SAP-REF-DOUBLE" "SAP-REF-LISPOBJ" "SAP-REF-LONG"
+ "SAP-REF-OCTETS"
"SAP-REF-SAP" "SAP-REF-SINGLE"
"SAP<" "SAP<=" "SAP=" "SAP>" "SAP>="
"SCRUB-CONTROL-STACK" "SERVE-ALL-EVENTS"
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 6dff66f..311a4b9 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -443,11 +443,10 @@
(error 'c-string-encoding-error
:external-format external-format
:code code))
-
-(defun c-string-decoding-error (external-format octets)
+(defun c-string-decoding-error (external-format sap offset count)
(error 'c-string-decoding-error
:external-format external-format
- :octets octets))
+ :octets (sap-ref-octets sap offset count)))
;;; Returning true goes into end of file handling, false will enter another
;;; round of input buffer filling followed by re-entering character decode.
@@ -1594,7 +1593,8 @@
(incf head size)
nil))
(when decode-break-reason
- (c-string-decoding-error ,name decode-break-reason))
+ (c-string-decoding-error
+ ,name sap head decode-break-reason))
(when (zerop (char-code char))
(return count))))
(string (make-string length :element-type element-type)))
@@ -1613,7 +1613,8 @@
(incf head size)
nil))
(when decode-break-reason
- (c-string-decoding-error ,name decode-break-reason))
+ (c-string-decoding-error
+ ,name sap head decode-break-reason))
(setf (aref string index) char)))))
(defun ,output-c-string-function (string)
diff --git a/src/code/target-sap.lisp b/src/code/target-sap.lisp
index edb3a16..17f7191 100644
--- a/src/code/target-sap.lisp
+++ b/src/code/target-sap.lisp
@@ -65,6 +65,14 @@
(fixnum offset))
(sap-ref-8 sap offset))
+(defun sap-ref-octets (sap offset count)
+ (declare (type system-area-pointer sap)
+ (fixnum offset count))
+ (let ((buffer (make-array count :element-type '(unsigned-byte 8))))
+ (dotimes (i count)
+ (setf (aref buffer i) (sap-ref-8 sap (+ offset i))))
+ buffer))
+
;;; Return the 16-bit word at OFFSET bytes from SAP.
(defun sap-ref-16 (sap offset)
(declare (type system-area-pointer sap)
diff --git a/tests/alien.impure.lisp b/tests/alien.impure.lisp
index fe5c18e..ff4f65b 100644
--- a/tests/alien.impure.lisp
+++ b/tests/alien.impure.lisp
@@ -332,4 +332,41 @@
(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
+ (let ((c-string (coerce #(70 111 246 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)))))
+
;;; success
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
------------------------------------------------------------------------------
For Developers, A Lot Can Happen In A Second.
Boundary is the first to Know...and Tell You.
Monitor Your Applications in Ultra-Fine Resolution. Try it FREE!
http://p.sf.net/sfu/Boundary-d2dvs2
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic