mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-23 12:00:21 +02:00
Code Activity

Add `define-wrapped-pointer-type'.

Browse source 
* module/system/foreign.scm (define-wrapped-pointer-type): New macro.

* doc/ref/api-foreign.texi (Foreign Types): Mention the `*' symbol.
  (Void Pointers and Byte Access): Document `define-wrapped-pointer-type'.

* test-suite/tests/foreign.test ("define-wrapped-pointer-type"): New
  test prefix.
This commit is contained in:
Ludovic Courtès 2011-01-30 22:00:35 +01:00
parent 2519490c50
commit 1f4f7674bc
3 changed files with 139 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

29
test-suite/tests/foreign.test
View file

@ -1,6 +1,6 @@
;;;; foreign.test --- FFI. -*- mode: scheme; coding: utf-8; -*-
;;;;
;;;; Copyright (C) 2010 Free Software Foundation, Inc.
;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@ -60,6 +60,33 @@
(pass-if "not equal?"
(not (equal? (make-pointer 123) (make-pointer 456)))))
(define-wrapped-pointer-type foo?
wrap-foo unwrap-foo
(lambda (x p)
(format p "#<foo! ~a>" (pointer-address (unwrap-foo x)))))
(with-test-prefix "define-wrapped-pointer-type"
(pass-if "foo?"
(foo? (wrap-foo %null-pointer)))
(pass-if "unwrap-foo"
(let ((p (make-pointer 123)))
(eq? p (unwrap-foo (wrap-foo p)))))
(pass-if "identity"
(let ((p1 (make-pointer 123))
(p2 (make-pointer 123)))
(eq? (wrap-foo p1)
(wrap-foo p2))))
(pass-if "printer"
(string=? "#<foo! 123>"
(with-output-to-string
(lambda ()
(write (wrap-foo (make-pointer 123))))))))
(with-test-prefix "pointer<->bytevector"