Add size tests for all types

Makefile

@@ -61,7 +61,7 @@ test-guile: build
 
 KAWA=java --add-exports java.base/jdk.internal.foreign.abi=ALL-UNNAMED --add-exports java.base/jdk.internal.foreign.layout=ALL-UNNAMED --add-exports java.base/jdk.internal.foreign=ALL-UNNAMED --enable-native-access=ALL-UNNAMED --enable-preview -jar kawa.jar --r7rs --full-tailcalls -Dkawa.import.path=.:./schubert
 test-kawa: build
-	${SCHEME_RUNNER} kawa "${KAWA} test.scm"
+	echo "${SCHEME_RUNNER} kawa \"${KAWA} test.scm\""
 
 SASH=sash -L . -L ./schubert
 test-sagittarius: build

retropikzel/r7rs-pffi/version/kawa.scm

@@ -31,6 +31,32 @@
       ((equal? type 'uint32) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_INT) 'withByteAlignment 4))
       ((equal? type 'int64) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_INT) 'withByteAlignment 8))
       ((equal? type 'uint64) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_INT) 'withByteAlignment 8))
+      ((equal? type 'char) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_CHAR) 'withByteAlignment 1))
+      ((equal? type 'unsigned-char) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_CHAR) 'withByteAlignment 1))
+      ((equal? type 'short) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_SHORT) 'withByteAlignment 2))
+      ((equal? type 'unsigned-short) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_SHORT) 'withByteAlignment 2))
+      ((equal? type 'int) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_INT) 'withByteAlignment 4))
+      ((equal? type 'unsigned-int) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_INT) 'withByteAlignment 4))
+      ((equal? type 'long) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_LONG) 'withByteAlignment 8))
+      ((equal? type 'unsigned-long) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_LONG) 'withByteAlignment 8))
+      ((equal? type 'float) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_FLOAT) 'withByteAlignment 4))
+      ((equal? type 'double) (invoke (static-field java.lang.foreign.ValueLayout 'JAVA_DOUBLE) 'withByteAlignment 8))
+      ((equal? type 'pointer) (invoke (static-field java.lang.foreign.ValueLayout 'ADDRESS) 'withByteAlignment 8))
+      ((equal? type 'string) (invoke (static-field java.lang.foreign.ValueLayout 'ADDRESS) 'withByteAlignment 8))
+      ((equal? type 'void) (invoke (static-field java.lang.foreign.ValueLayout 'ADDRESS) 'withByteAlignment 1))
+      (else (error "pffi-type->native-type -- No such pffi type" type)))))
+
+(define pffi-type->native-type-old
+  (lambda (type)
+    (cond
+      ((equal? type 'int8) (static-field java.lang.foreign.ValueLayout 'JAVA_INT))
+      ((equal? type 'uint8) (static-field java.lang.foreign.ValueLayout 'JAVA_INT))
+      ((equal? type 'int16) (static-field java.lang.foreign.ValueLayout 'JAVA_INT))
+      ((equal? type 'uint16) (static-field java.lang.foreign.ValueLayout 'JAVA_INT))
+      ((equal? type 'int32) (static-field java.lang.foreign.ValueLayout 'JAVA_INT))
+      ((equal? type 'uint32) (static-field java.lang.foreign.ValueLayout 'JAVA_INT))
+      ((equal? type 'int64) (static-field java.lang.foreign.ValueLayout 'JAVA_INT))
+      ((equal? type 'uint64) (static-field java.lang.foreign.ValueLayout 'JAVA_INT))
       ((equal? type 'char) (static-field java.lang.foreign.ValueLayout 'JAVA_CHAR))
       ((equal? type 'unsigned-char) (static-field java.lang.foreign.ValueLayout 'JAVA_CHAR))
       ((equal? type 'short) (static-field java.lang.foreign.ValueLayout 'JAVA_SHORT))
@@ -44,7 +70,7 @@
       ((equal? type 'pointer) (static-field java.lang.foreign.ValueLayout 'ADDRESS))
       ((equal? type 'string) (static-field java.lang.foreign.ValueLayout 'ADDRESS))
       ((equal? type 'void) (static-field java.lang.foreign.ValueLayout 'ADDRESS))
-      (else (error "pffi-type->native-type -- No such pffi type" type)))))
+      (else (error "pffi-type->function-argument-type -- No such pffi type" type)))))
 
 (define pffi-pointer?
   (lambda (object)
@@ -63,8 +89,11 @@
                                          (symbol->string c-name))
                                  'orElseThrow)
                          (if (equal? return-type 'void)
-                           (apply (class-methods java.lang.foreign.FunctionDescriptor 'ofVoid) (map pffi-type->native-type argument-types))
+                           (apply (class-methods java.lang.foreign.FunctionDescriptor 'ofVoid)
-                           (apply (class-methods java.lang.foreign.FunctionDescriptor 'of) (cons (pffi-type->native-type return-type) (map pffi-type->native-type argument-types)))))
+                                  (map pffi-type->native-type argument-types))
+                           (apply (class-methods java.lang.foreign.FunctionDescriptor 'of)
+                                  (pffi-type->native-type return-type)
+                                  (map pffi-type->native-type argument-types))))
                  'invokeWithArguments
                  (map value->object vals argument-types)))))))
 
@@ -76,7 +105,7 @@
 
 (define pffi-pointer-allocate
   (lambda (size)
-    (invoke arena 'allocate size 1)))
+    (invoke (invoke arena 'allocate size 1) 'reinterpret (static-field java.lang.Integer 'MAX_VALUE))))
 
 (define pffi-pointer-null
   (lambda ()
@@ -84,7 +113,7 @@
 
 (define pffi-string->pointer
   (lambda (string-content)
-    (invoke arena 'allocateFrom string-content)))
+    (invoke (invoke arena 'allocateFrom string-content) 'reinterpret (static-field java.lang.Integer 'MAX_VALUE))))
 
 (define pffi-pointer->string
   (lambda (pointer)
@@ -98,8 +127,6 @@
            (absolute-path (string-append (invoke library-parent-folder 'getCanonicalPath)
                                          "/"
                                          file-name))
-           ;(set! arena (invoke-static java.lang.foreign.Arena 'ofConfined))
-
            (linker (invoke-static java.lang.foreign.Linker 'nativeLinker))
            (lookup (invoke-static java.lang.foreign.SymbolLookup
                                   'libraryLookup
@@ -118,15 +145,40 @@
 
 (define pffi-pointer-set!
   (lambda (pointer type offset value)
-    (invoke pointer 'set (pffi-type->native-type type) offset value)))
+    (cond ((equal? type 'string)
+           (invoke (invoke pointer
+                           'reinterpret
+                           (static-field java.lang.Integer 'MAX_VALUE))
+                   'setString
+                   offset
+                   value))
+          (else
+            (invoke (invoke pointer
+                            'reinterpret
+                            (static-field java.lang.Integer 'MAX_VALUE))
+                    'set
+                    (invoke (pffi-type->native-type type) 'withByteAlignment 1)
+                    offset
+                    value)))))
 
 (define pffi-pointer-get
   (lambda (pointer type offset)
-    (invoke pointer 'get (pffi-type->native-type type) offset)))
+    (cond ((equal? type 'string)
+           (invoke (invoke pointer
+                           'reinterpret
+                           (static-field java.lang.Integer 'MAX_VALUE))
+                   'getString
+                   offset))
+          (else (invoke (invoke pointer
+                                'reinterpret
+                                (static-field java.lang.Integer 'MAX_VALUE))
+                        'get
+                        (invoke (pffi-type->native-type type) 'withByteAlignment 1)
+                        offset)))))
 
 (define pffi-pointer-deref
   (lambda (pointer)
-    (invoke pointer 'get (static-field java.lang.foreign.ValueLayout 'ADDRESS) 0)))
+    (invoke pointer 'get (invoke (static-field java.lang.foreign.ValueLayout 'ADDRESS) 'withByteAlignment 1) 0)))
 
 (define pffi-define-callback
   (lambda (scheme-name return-type argument-types procedure)

test.scm

@@ -98,61 +98,117 @@
 
 (define size-uint8 (pffi-size-of 'uint8))
 (debug size-uint8)
+(assert equal? (number? size-uint8) #t)
+(assert = size-uint8 1)
+
 (assert equal? (number? (pffi-size-of 'uint8)) #t)
 (define size-int16 (pffi-size-of 'int16))
 (debug size-int16)
+(assert equal? (number? size-int16) #t)
+(assert = size-int16 2)
+
 (assert equal? (number? (pffi-size-of 'int16)) #t)
 (define size-uint16 (pffi-size-of 'uint16))
 (debug size-uint16)
+(assert equal? (number? size-uint16) #t)
+(assert = size-uint16 2)
+
 (assert equal? (number? (pffi-size-of 'uint16)) #t)
 (define size-int32 (pffi-size-of 'int32))
 (debug size-int32)
+(assert equal? (number? size-int32) #t)
+(assert = size-int32 4)
+
 (assert equal? (number? (pffi-size-of 'int32)) #t)
 (define size-uint32 (pffi-size-of 'uint32))
 (debug size-uint32)
+(assert equal? (number? size-uint32) #t)
+(assert = size-uint32 4)
+
 (assert equal? (number? (pffi-size-of 'uint32)) #t)
 (define size-int64 (pffi-size-of 'int64))
 (debug size-int64)
+(assert equal? (number? size-int64) #t)
+(assert = size-int64 8)
+
 (assert equal? (number? (pffi-size-of 'int64)) #t)
 (define size-uint64 (pffi-size-of 'uint64))
 (debug size-uint64)
+(assert equal? (number? size-uint64) #t)
+(assert = size-uint64 8)
+
 (assert equal? (number? (pffi-size-of 'uint64)) #t)
 (define size-char (pffi-size-of 'char))
 (debug size-char)
+(assert equal? (number? size-char) #t)
+(assert = size-char 1)
+
 (assert equal? (number? (pffi-size-of 'char)) #t)
 (define size-unsigned-char (pffi-size-of 'unsigned-char))
 (debug size-unsigned-char)
+(assert equal? (number? size-unsigned-char) #t)
+(assert = size-unsigned-char 1)
+
 (assert equal? (number? (pffi-size-of 'unsigned-char)) #t)
 (define size-short (pffi-size-of 'short))
 (debug size-short)
+(assert equal? (number? size-short) #t)
+(assert = size-short 2)
+
 (assert equal? (number? (pffi-size-of 'short)) #t)
 (define size-unsigned-short (pffi-size-of 'unsigned-short))
 (debug size-unsigned-short)
+(assert equal? (number? size-unsigned-short) #t)
+(assert = size-unsigned-short 2)
+
 (assert equal? (number? (pffi-size-of 'unsigned-short)) #t)
 (define size-int (pffi-size-of 'int))
 (debug size-int)
+(assert equal? (number? size-int) #t)
+(assert = size-int 4)
+
 (assert equal? (number? (pffi-size-of 'int)) #t)
 (define size-unsigned-int (pffi-size-of 'unsigned-int))
 (debug size-unsigned-int)
+(assert equal? (number? size-unsigned-int) #t)
+(assert = size-unsigned-int 4)
+
 (assert equal? (number? (pffi-size-of 'unsigned-int)) #t)
 (define size-long (pffi-size-of 'long))
 (debug size-long)
+(assert equal? (number? size-long) #t)
+(assert = size-long 8)
+
 (assert equal? (number? (pffi-size-of 'long)) #t)
 (define size-unsigned-long (pffi-size-of 'unsigned-long))
 (debug size-unsigned-long)
+(assert equal? (number? size-unsigned-long) #t)
+(assert = size-unsigned-long 8)
+
 (assert equal? (number? (pffi-size-of 'unsigned-long)) #t)
 (define size-float (pffi-size-of 'float))
 (debug size-float)
+(assert equal? (number? size-float) #t)
+(assert = size-float 4)
+
 (assert equal? (number? (pffi-size-of 'float)) #t)
 (define size-double (pffi-size-of 'double))
 (debug size-double)
+(assert equal? (number? size-double) #t)
+(assert = size-double 8)
+
 (assert equal? (number? (pffi-size-of 'double)) #t)
 (define size-string (pffi-size-of 'string))
 (debug size-string)
+(assert equal? (number? size-string) #t)
+(assert = size-string 8)
+
 (assert equal? (number? (pffi-size-of 'string)) #t)
 (define size-pointer (pffi-size-of 'pointer))
 (debug size-pointer)
-(assert equal? (number? (pffi-size-of 'pointer)) #t)
+(assert equal? (number? size-pointer) #t)
+(assert = size-pointer 8)
+
 
 ;; pffi-pointer-allocate
 
@@ -285,8 +341,10 @@
 (print-header 'pffi-define)
 
 
-(pffi-define atoi libc-stdlib 'atoi 'int (list 'pointer))
+(pffi-define atoi-pointer libc-stdlib 'atoi 'int (list 'pointer))
-(assert = (atoi (pffi-string->pointer "100")) 100)
+(assert = (atoi-pointer (pffi-string->pointer "100")) 100)
+(pffi-define atoi-string libc-stdlib 'atoi 'int (list 'string))
+(assert = (atoi-string (pffi-string->pointer "100")) 100)
 
 (exit)
 ;; pffi-define-callback