Racket uint8-ref/set! fixes

foreign/c/primitives/racket.scm

@@ -1,7 +1,7 @@
 (define type->native-type
   (lambda (type)
-    (cond ((equal? type 'int8) _int8)
+    (cond ((equal? type 'int8) _byte)
-          ((equal? type 'uint8) _uint8)
+          ((equal? type 'uint8) _ubyte)
           ((equal? type 'int16) _int16)
           ((equal? type 'uint16) _uint16)
           ((equal? type 'int32) _int32)
@@ -59,11 +59,21 @@
 
 (define c-bytevector-u8-set!
   (lambda (c-bytevector k byte)
-    (ptr-set! c-bytevector _byte 'abs k byte)))
+    (ptr-set! c-bytevector _ubyte 'abs k byte)))
 
 (define c-bytevector-u8-ref
   (lambda (c-bytevector k)
-    (ptr-ref c-bytevector _ubyte 'abs k)))
+    (let ((result (ptr-ref c-bytevector _ubyte 'abs k)))
+      (display "c-bytevector: ")
+      (display c-bytevector)
+      (newline)
+      (display "k: ")
+      (display k)
+      (newline)
+      (display "Result: ")
+      (display result)
+      (newline)
+      result)))
 
 (define c-bytevector-pointer-set!
   (lambda (c-bytevector k pointer)

tests/c-bytevector.scm

@@ -0,0 +1,83 @@
+(import (scheme base)
+        (scheme write)
+        (scheme read)
+        (scheme char)
+        (scheme file)
+        (scheme process-context)
+        (foreign c))
+
+;; util
+(define header-count 1)
+
+(define print-header
+  (lambda (title)
+    (set-tag title)
+    (display "=========================================")
+    (newline)
+    (display header-count)
+    (display " ")
+    (display title)
+    (newline)
+    (display "=========================================")
+    (newline)
+    (set! header-count (+ header-count 1))))
+
+(define count 0)
+(define assert-tag 'none)
+
+(define set-tag
+  (lambda (tag)
+    (set! assert-tag tag)
+    (set! count 0)))
+
+(cond-expand
+  (gambit
+    (define assert
+      (lambda (check value-a value-b)
+        (let ((result (apply check (list value-a value-b))))
+          (set! count (+ count 1))
+          (if (not result) (display "FAIL ") (display "PASS "))
+          (display "[")
+          (display assert-tag)
+          (display " - ")
+          (display count)
+          (display "]")
+          (display ": ")
+          (write (list 'check 'value-a 'value-b))
+          (newline)
+          (when (not result) (exit 1))))))
+  (else
+    (define-syntax assert
+      (syntax-rules ()
+        ((_ check value-a value-b)
+         (let ((result (apply check (list value-a value-b))))
+           (set! count (+ count 1))
+           (if (not result) (display "FAIL ") (display "PASS "))
+           (display "[")
+           (display assert-tag)
+           (display " - ")
+           (display count)
+           (display "]")
+           (display ": ")
+           (write (list 'check 'value-a 'value-b))
+           (newline)
+           (when (not result) (exit 1))))))))
+
+(define-syntax debug
+  (syntax-rules ()
+    ((_ value)
+     (begin
+       (display 'value)
+       (display ": ")
+       (write value)
+       (newline)))))
+
+(let* ((pointer-size (c-type-size 'long))
+       (pointer (make-c-bytevector (c-type-size 'long))))
+  (c-bytevector-sint-set! pointer 0 42 (native-endianness) pointer-size)
+  (let ((value (c-bytevector-sint-ref pointer 0 (native-endianness) pointer-size)))
+    (c-free pointer)
+    (display "Code: ")
+    (display value)
+    (newline)
+    (assert = value 42)))