~ chicken-core (chicken-5) e3b88bfb10790af391d933843c02050874fbb066

commit e3b88bfb10790af391d933843c02050874fbb066
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sat May 22 14:40:39 2010 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sat May 22 14:40:39 2010 +0200

    ##sys#make-c-string checks for embedded NUL bytes (thanks to Peter Bex)

diff --git a/library.scm b/library.scm
index 59c39db3..f4fdadde 100644
--- a/library.scm
+++ b/library.scm
@@ -66,6 +66,7 @@
 #define C_close_file(p)	      (C_fclose((C_FILEPTR)(C_port_file(p))), C_SCHEME_UNDEFINED)
 #define C_a_f64peek(ptr, c, b, i)  C_flonum(ptr, ((double *)C_data_pointer(b))[ C_unfix(i) ])
 #define C_fetch_c_strlen(b, i) C_fix(strlen((C_char *)C_block_item(b, C_unfix(i))))
+#define C_asciiz_strlen(str) C_fix(strlen(C_c_string(str)))
 #define C_peek_c_string(b, i, to, len) (C_memcpy(C_data_pointer(to), (C_char *)C_block_item(b, C_unfix(i)), C_unfix(len)), C_SCHEME_UNDEFINED)
 #define C_free_mptr(p, i)     (C_free((void *)C_block_item(p, C_unfix(i))), C_SCHEME_UNDEFINED)
 #define C_free_sptr(p, i)     (C_free((void *)(((C_char **)C_block_item(p, 0))[ C_unfix(i) ])), C_SCHEME_UNDEFINED)
@@ -3737,10 +3738,16 @@ EOF
   ;; *** '4' is platform dependent!
   (##core#inline_allocate ("C_a_unsigned_int_to_num" 4) (##sys#slot ptr 0)) )
 
-(define (##sys#make-c-string str)
-  (##sys#string-append
-   str
-   (string (##core#inline "C_make_character" (##core#inline "C_unfix" 0)))) )
+(define (##sys#make-c-string str #!optional (loc '##sys#make-c-string))
+  (let* ([len (##sys#size str)]
+         [buf (##sys#make-string (fx+ len 1))] )
+    (##core#inline "C_substring_copy" str buf 0 len 0)
+    (##core#inline "C_setsubchar" buf len #\nul)
+    (if (fx= (##core#inline "C_asciiz_strlen" buf) len)
+        buf
+        (##sys#signal-hook #:type-error loc
+                           "cannot represent string with NUL bytes as C string"
+                           str))) )
 
 (define ##sys#peek-signed-integer (##core#primitive "C_peek_signed_integer"))
 (define ##sys#peek-unsigned-integer (##core#primitive "C_peek_unsigned_integer"))
diff --git a/tests/compiler-tests.scm b/tests/compiler-tests.scm
index 65ebcb89..923c4358 100644
--- a/tests/compiler-tests.scm
+++ b/tests/compiler-tests.scm
@@ -123,3 +123,12 @@
 			(set! x #t)
 			f1)))))
     (for-each f1 '(1 2 3))))
+
+(newline)
+
+;; Test safety of ##sys#make-c-string
+(handle-exceptions exn (print "Good, unrepresentable C strings cause errors")
+                   (print "BUG! We got, without error, length = "
+                          ((foreign-lambda* int ((c-string str))
+                                            "C_return(strlen(str));")
+                           "foo\x00bar")))