Fix <CFString> and CF>string to allow null bytes

basis/core-foundation/attributed-strings/attributed-strings-tests.factor

@@ -4,4 +4,4 @@ USING: tools.test core-foundation.attributed-strings
 core-foundation ;
 IN: core-foundation.attributed-strings.tests
 
-[ ] [ "Hello world" { } <CFAttributedString> CFRelease ] unit-test
+[ ] [ "Hello world" H{ } <CFAttributedString> CFRelease ] unit-test

basis/core-foundation/attributed-strings/attributed-strings.factor

@@ -12,7 +12,7 @@ FUNCTION: CFAttributedStringRef CFAttributedStringCreate (
    CFDictionaryRef attributes
 ) ;
 
-: <CFAttributedString> ( string alist -- alien )
+: <CFAttributedString> ( string assoc -- alien )
     [
         [ >cf &CFRelease ] bi@
         [ kCFAllocatorDefault ] 2dip CFAttributedStringCreate

basis/core-foundation/core-foundation.factor

@@ -1,21 +1,34 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax alien.destructors accessors kernel ;
+USING: alien.syntax alien.c-types alien.destructors accessors kernel ;
 IN: core-foundation
 
 TYPEDEF: void* CFTypeRef
 
 TYPEDEF: void* CFAllocatorRef
-: kCFAllocatorDefault f ; inline
+CONSTANT: kCFAllocatorDefault f
 
 TYPEDEF: bool Boolean
 TYPEDEF: long CFIndex
+TYPEDEF: char UInt8
 TYPEDEF: int SInt32
 TYPEDEF: uint UInt32
 TYPEDEF: ulong CFTypeID
 TYPEDEF: UInt32 CFOptionFlags
 TYPEDEF: void* CFUUIDRef
 
+ALIAS: <CFIndex> <long>
+ALIAS: *CFIndex *long
+
+C-STRUCT: CFRange
+{ "CFIndex" "location" }
+{ "CFIndex" "length" } ;
+
+: <CFRange> ( location length -- range )
+    "CFRange" <c-object>
+    [ set-CFRange-length ] keep
+    [ set-CFRange-location ] keep ;
+
 FUNCTION: CFTypeRef CFRetain ( CFTypeRef cf ) ;
 
 FUNCTION: void CFRelease ( CFTypeRef cf ) ;

basis/core-foundation/strings/strings-tests.factor

@@ -7,3 +7,5 @@ IN: core-foundation
 [ "Hello" ] [ "Hello" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
 [ "Hello\u003456" ] [ "Hello\u003456" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
 [ "Hello\u013456" ] [ "Hello\u013456" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
+[ ] [ "\0" <CFString> CFRelease ] unit-test
+[ "\0" ] [ "\0" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test

basis/core-foundation/strings/strings.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax alien.strings kernel sequences byte-arrays
-io.encodings.utf8 math core-foundation core-foundation.arrays
-destructors ;
+USING: alien.syntax alien.strings io.encodings.string kernel
+sequences byte-arrays io.encodings.utf8 math core-foundation
+core-foundation.arrays destructors ;
 IN: core-foundation.strings
 
 TYPEDEF: void* CFStringRef
@@ -42,6 +42,17 @@ FUNCTION: Boolean CFStringGetCString (
     CFStringEncoding encoding
 ) ;
 
+FUNCTION: CFIndex CFStringGetBytes (
+   CFStringRef theString,
+   CFRange range,
+   CFStringEncoding encoding,
+   UInt8 lossByte,
+   Boolean isExternalRepresentation,
+   UInt8* buffer,
+   CFIndex maxBufLen,
+   CFIndex* usedBufLen
+) ;
+
 FUNCTION: CFStringRef CFStringCreateWithCString (
     CFAllocatorRef alloc,
     char* cStr,
@@ -49,16 +60,14 @@ FUNCTION: CFStringRef CFStringCreateWithCString (
 ) ;
 
 : <CFString> ( string -- alien )
-    f swap utf8 string>alien kCFStringEncodingUTF8 CFStringCreateWithCString
-    [ "CFStringCreateWithCString failed" throw ] unless* ;
+    [ f ] dip utf8 encode dup length kCFStringEncodingUTF8 f CFStringCreateWithBytes
+    [ "CFStringCreateWithBytes failed" throw ] unless* ;
 
 : CF>string ( alien -- string )
-    dup CFStringGetLength 4 * 1 + <byte-array> [
-        dup length
-        kCFStringEncodingUTF8
-        CFStringGetCString
-        [ "CFStringGetCString failed" throw ] unless
-    ] keep utf8 alien>string ;
+    dup CFStringGetLength
+    [ 0 swap <CFRange> kCFStringEncodingUTF8 0 f ] keep
+    4 * 1 + <byte-array> [ dup length 0 <CFIndex> [ CFStringGetBytes drop ] keep ] keep
+    swap *CFIndex head-slice utf8 decode ;
 
 : CF>string-array ( alien -- seq )
     CF>array [ CF>string ] map ;