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 20:00:49 +03:00
parent 1866f298eb
commit 8ccfc69395
2 changed files with 4 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

2
tests/primitives.scm
View File

@ -309,6 +309,8 @@
(define c-string1 (string->c-utf8 "test123")) (define c-string1 (string->c-utf8 "test123"))
(debug (c-utf8->string c-string1)) (debug (c-utf8->string c-string1))
(debug (c-utf8->string (c-strcat (string->c-utf8 "con1") (string->c-utf8 "cat1")))) (debug (c-utf8->string (c-strcat (string->c-utf8 "con1") (string->c-utf8 "cat1"))))
(debug (c-utf8->string (c-strcat (string->c-utf8 "con2")
(string->c-utf8 "cat2"))))
(assert equal? (string=? (c-utf8->string (c-strcat (string->c-utf8 "con2") (assert equal? (string=? (c-utf8->string (c-strcat (string->c-utf8 "con2")
(string->c-utf8 "cat2"))) (string->c-utf8 "cat2")))
"con2cat2") #t) "con2cat2") #t)