Retropikzel
/
foreign-c
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Progress with Gauche

This commit is contained in:
retropikzel 2025-04-27 19:36:35 +03:00
parent 3c75f1eb5a
commit 1866f298eb
2 changed files with 11 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
foreign/c/primitives/gauche.scm
View File

@ -201,14 +201,14 @@
c-function c-function
(size-of-type return-type) (size-of-type return-type)
arguments))) arguments)))
(display "HERE: ") (display "Calling C function: ")
(write c-name)
(newline)
(display "HERE SCM:")
(write return-pointer) (write return-pointer)
(newline) (newline)
(display "HERE2: ") (cond ((not (equal? return-type 'void))
(write (pointer-get return-pointer return-type 0)) (pointer-get return-pointer return-type 0))))))))
(newline)
(when (not (equal? return-type 'void))
(pointer-get return-pointer return-type 0)))))))
(define-syntax define-c-procedure (define-syntax define-c-procedure
(syntax-rules () (syntax-rules ()

6
tests/primitives.scm
View File

@ -284,7 +284,11 @@
(for-each (for-each
(lambda (str) (lambda (str)
(debug str) (debug str)
(assert equal? (string=? (c-utf8->string (string->c-utf8 str)) str) #t)) (let ((utf-eight (string->c-utf8 str)))
(debug utf-eight)
(let ((str1 (c-utf8->string utf-eight)))
(debug str1)
(assert equal? (string=? str1 str) #t))))
(list "100" "Hello world" "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")) (list "100" "Hello world" "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"))