Started building the unified test file

Makefile

@@ -18,6 +18,12 @@ test-tier1: \
 	test-sagittarius \
 	test-racket
 
+test-tier2:
+	test-cyclone \
+	test-gambit \
+	test-stklos
+	
+
 CHICKEN_LIB=csc -X r7rs -R r7rs -s -J
 build-chicken-libs:
 	cp retropikzel/r7rs-pffi/version/chicken.scm retropikzel.r7rs-pffi.version.chicken.scm
@@ -53,7 +59,8 @@ test-gambit: clean build
 
 GUILE=guile -L . -L ./schubert
 test-guile: build
-	${SCHEME_RUNNER} guile "${GUILE} test.scm"
+	#${SCHEME_RUNNER} guile "${GUILE} test.scm"
+	${GUILE} test.scm
 
 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
@@ -63,21 +70,10 @@ SASH=sash -L . -L ./schubert
 test-sagittarius: build
 	${SCHEME_RUNNER} sagittarius "${SASH} test.scm"
 
-test-sagittarius-wine: build
-	PACKAGES="${TEST_PACKAGES_APT}" \
-	WINE="true" \
-		scheme_runner sagittarius "bash"
-
 RACKET=racket -I r7rs -S . -S ./schubert --script
 test-racket: build
-	#${SCHEME_RUNNER} racket "racket --help"
 	${SCHEME_RUNNER} racket "${RACKET} test.scm"
 
-test-racket-wine: build
-	PACKAGES="${TEST_PACKAGES_APT}" \
-	WINE=true \
-		scheme_runner racket "bash test-racket-wine.sh"
-
 STKLOS=stklos -A . -A ./schubert -f
 test-stklos: build
 	${SCHEME_RUNNER} stklos "${STKLOS} test.scm"

retropikzel/r7rs-pffi/version/chicken.scm

@@ -143,32 +143,6 @@
                                 (begin ,@ procedure-body))
                       (define ,scheme-name (location external_123456789)))))))
 
-    (define-syntax pffi-size-of-old
-      (er-macro-transformer
-        (lambda (expr rename compare)
-          (let ((type (car (cdr (car (cdr expr))))))
-            (cond ((equal? type 'int8) `(foreign-value "sizeof(int8_t)" int))
-                  ((equal? type 'uint8) `(foreign-value "sizeof(uint8_t)" int))
-                  ((equal? type 'int16) `(foreign-value "sizeof(int16_t)" int))
-                  ((equal? type 'uint16) `(foreign-value "sizeof(uint16_t)" int))
-                  ((equal? type 'int32) `(foreign-value "sizeof(int32_t)" int))
-                  ((equal? type 'uint32) `(foreign-value "sizeof(uint32_t)" int))
-                  ((equal? type 'int64) `(foreign-value "sizeof(int64_t)" int))
-                  ((equal? type 'uint64) `(foreign-value "sizeof(uint64_t)" int))
-                  ((equal? type 'char) `(foreign-value "sizeof(char)" int))
-                  ((equal? type 'unsigned-char) `(foreign-value "sizeof(unsigned char)" int))
-                  ((equal? type 'short) `(foreign-value "sizeof(short)" int))
-                  ((equal? type 'unsigned-short) `(foreign-value "sizeof(unsigned short)" int))
-                  ((equal? type 'int) `(foreign-value "sizeof(int)" int))
-                  ((equal? type 'unsigned-int) `(foreign-value "sizeof(unsigned int)" int))
-                  ((equal? type 'long) `(foreign-value "sizeof(long)" int))
-                  ((equal? type 'unsigned-long) `(foreign-value "sizeof(unsigned long)" int))
-                  ((equal? type 'float) `(foreign-value "sizeof(float)" int))
-                  ((equal? type 'double) `(foreign-value "sizeof(double)" int))
-                  ((equal? type 'pointer) `(foreign-value "sizeof(void*)" int))
-                  ((equal? type 'string) `(foreign-value "sizeof(void*)" int))
-                  (else `(error "pffi-size-of -- No such pffi type" type)))))))
-
     (define pffi-size-of
       (lambda (type)
         (cond ((equal? type 'int8) (foreign-value "sizeof(int8_t)" int))

retropikzel/r7rs-pffi/version/guile.scm

@@ -70,7 +70,6 @@
                                procedure
                                (map pffi-type->native-type argument-types))))))
 
-
     (define pffi-size-of
       (lambda (type)
         (sizeof (pffi-type->native-type type))))

retropikzel/r7rs-pffi/version/main.rkt

@@ -63,7 +63,8 @@
               (scheme write)
               (scheme file)
               (scheme process-context)
-              (retropikzel r7rs-pffi version mit-scheme))))
+              (retropikzel r7rs-pffi version mit-scheme)))
+    (else (error "Unsupported version")))
   (export pffi-init
           pffi-shared-object-auto-load
           pffi-shared-object-load
@@ -90,7 +91,6 @@
            (chicken (import (chicken foreign)))
            (else #t)))))
 
-
     (define pffi-os-name
       (cond-expand
         (windows "windows")

retropikzel/r7rs-pffi/version/main.scm

@@ -62,7 +62,8 @@
               (scheme write)
               (scheme file)
               (scheme process-context)
-              (retropikzel r7rs-pffi version mit-scheme))))
+              (retropikzel r7rs-pffi version mit-scheme)))
+    (else (error "Unsupported version")))
   (export pffi-init
           pffi-shared-object-auto-load
           pffi-shared-object-load
@@ -89,7 +90,6 @@
            (chicken (import (chicken foreign)))
            (else #t)))))
 
-
     (define pffi-os-name
       (cond-expand
         (windows "windows")

retropikzel/r7rs-pffi/version/main.sld

@@ -62,7 +62,8 @@
               (scheme write)
               (scheme file)
               (scheme process-context)
-              (retropikzel r7rs-pffi version mit-scheme))))
+              (retropikzel r7rs-pffi version mit-scheme)))
+    (else (error "Unsupported version")))
   (export pffi-init
           pffi-shared-object-auto-load
           pffi-shared-object-load
@@ -89,7 +90,6 @@
            (chicken (import (chicken foreign)))
            (else #t)))))
 
-
     (define pffi-os-name
       (cond-expand
         (windows "windows")

test.scm

@@ -4,19 +4,42 @@
         (scheme process-context)
         (retropikzel r7rs-pffi version main))
 
-(define tag 'none)
+(define exit-on-fail? #t)
 
+(define tag 'none)
 (define-syntax assert
   (syntax-rules ()
     ((_ check value)
-     (when (not (apply check (list value)))
+     (let ((result (apply check (list value))))
+       (if (not result) (display "FAIL: ") (display "PASS: "))
        (display "[")
        (display tag)
        (display "] ")
-       (display "Assert failed: ")
        (write (list 'check 'value))
-       (newline)))))
+       (newline)
+       (when (and exit-on-fail? (not result)) (exit 1))
+       ))))
 
+;; pffi-init
+
+(set! tag 'pffi-init)
+
+(pffi-init)
+
+;; pffi-shared-object-auto-load
+(set! tag 'pffi-shared-object-auto-load-libc)
+
+(define libc-stdlib
+  (if (string=? pffi-os-name "windows")
+    (pffi-shared-object-auto-load (list "stdlib.h") (list) "ucrtbase" (list ""))
+    (pffi-shared-object-auto-load (list "stdlib.h") (list) "c" (list "" ".6"))))
+
+;; pffi-define
+(set! tag 'pffi-define-atoi)
+(pffi-define atoi libc-stdlib 'atoi 'int (list 'pointer))
+(assert number? (atoi (pffi-string->pointer "100")))
+
+;; Size of
 
 (set! tag 'size-of)
 (assert number? (pffi-size-of 'int8))
@@ -38,7 +61,6 @@
 (assert number? (pffi-size-of 'float))
 (assert number? (pffi-size-of 'double))
 (assert number? (pffi-size-of 'string))
-(assert string? (pffi-size-of 'pointer))
+(assert number? (pffi-size-of 'pointer))
-
 
 (exit 0)