test-alist-ref: pass
(define (test-alist-ref _)
(let ((alst '((a 3) (b 2))))
(⊦= '(3) (alist-ref 'a alst))
(⊦= '(2) (alist-ref 'b alst))
(⊦= #f (alist-ref 'c alst))))
((eta 0.0) (memory #(6291456 1298192 1048576)) (stdout "") (stderr ""))
test/len: pass
(define (test/len _)
(let ((my-strlen
(foreign-lambda*
int
((scheme-object cons))
"C_return(C_header_size(cons));")))
(⊦= 2 (my-strlen (cons 1 '())))
(⊦= 2 (my-strlen (cons 1 (cons 2 (cons 3 '())))))
(⊦= 11 (my-strlen "hello world"))))
((eta 0.0) (memory #(6291456 1298800 1048576)) (stdout "") (stderr ""))
test/unquote: pass
Very interesting test about quasiquotation [1] : it shows how unquote can be used in a quasiquotation pattern in the cdr slot.
(define (test/unquote _) (let1 (a '(3)) (⊦= (cons 1 a) `(1 unquote a))))
((eta 0.0) (memory #(6291456 1299744 1048576)) (stdout "") (stderr ""))
test/c_callback: pass
(define (test/c_callback _)
(let ((witness (gensym))
(my-strlen
(foreign-safe-lambda*
scheme-object
((scheme-object f))
"\t\t\t\t\t C_word res = C_callback(f, 0);\n\t\t\t\t\t printf(\"from within a safe lambda\\n\");\n\t\t\t\t\t C_return (res);")))
(⊦= witness (car (my-strlen (lambda () (list witness 4)))))))
((eta 0.001) (memory #(6291456 1300376 1048576)) (stdout "") (stderr ""))
test/foreign-safe-lambda*/allocate_string/inline: pass
(define (test/foreign-safe-lambda*/allocate_string/inline _)
(let1 (allocate_string
(foreign-safe-lambda*
scheme-object
()
" char* str = \"hello world\";\n C_word length = strlen(str);\n C_word* ptr = C_alloc (C_SIZEOF_STRING (length));\n C_word res = C_string (&ptr, length, str);\n C_return (res);"))
(⊦= "hello world" (allocate_string))))
((eta 0.0) (memory #(6291456 1301008 1048576)) (stdout "") (stderr ""))
test/foreign-primitive/allocate-string: pass
An example of foreign-primitive [2] that allocates a string in C and returns it to Scheme. The C code is inlined in the Scheme source code.
(define (test/foreign-primitive/allocate-string _)
(let1 (allocate_string
(foreign-primitive scheme-object () "C_my_allocate_string(C_k);"))
(⊦= "hello world" (allocate_string))))
((eta 0.0) (memory #(6291456 1302096 1048576)) (stdout "") (stderr ""))
test/foreign-safe-lambda/list-walk: pass
(define (test/foreign-safe-lambda/list-walk _)
(let1 (list-walk
(foreign-safe-lambda
scheme-object
"C_list_walk"
scheme-object
scheme-object))
(⊦= '(1 2 3) (list-walk '(1 2 3) identity))))
((eta 0.0) (memory #(6291456 1302728 1048576)) (stdout "") (stderr ""))
test/foreign/callout-callin: pass
This test shows how to call out to C code that in turn calls back into Scheme code. The C code is in the file bar.c, and the function called from Scheme is callout. The function that is called back from C into Scheme is callin. Taken from the Chicken Scheme manual [3].
(define (test/foreign/callout-callin _)
(define callout (foreign-safe-lambda int "callout" int int int))
(define-external
(callin (scheme-object xyz))
int
(print "This is 'callin': " xyz)
123)
(⊦= 123 (callout 1 2 3)))
((eta 0.0)
(memory #(6291456 1304016 1048576))
(stdout "This is 'callin': (1 2 3)\n")
(stderr ""))
test/matchable/?: pass
(define (test/matchable/? _)
(⊦= '(a) (match '(1 a) (((? odd?) a) (list a)))))
((eta 0.0) (memory #(6291456 1304648 1048576)) (stdout "") (stderr ""))
test/string/ref: pass
(define (test/string/ref _) (⊦ equal? #\o (string-ref "hello" 4)))
((eta 0.0) (memory #(6291456 1305280 1048576)) (stdout "") (stderr ""))
test/string/last: pass
(define (test/string/last _) (⊦ equal? #\o (string-last "hello")))
((eta 0.0) (memory #(6291456 1305912 1048576)) (stdout "") (stderr ""))
test/string/take-right: pass
(define (test/string/take-right _)
(⊦ equal? "o" (string-take-right "hello" 1)))
((eta 0.0) (memory #(6291456 1306544 1048576)) (stdout "") (stderr ""))
test-null-eq?: pass
(define (test-null-eq? _) (⊨ (eq? '() '())))
((eta 0.0) (memory #(6291456 1307176 1048576)) (stdout "") (stderr ""))
[2]
foreign-primitive, Chicken Scheme manual.[3] An example for simple calls to foreign code involving callbacks, Chicken Scheme manual.