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

Simplify the (system foreign) API.

Browse source 
Suggested by Neil Jerram.

* libguile/foreign.h (SCM_FOREIGN_TYPE, SCM_FOREIGN_VALUE_REF,
  SCM_FOREIGN_VALUE_SET, SCM_FOREIGN_LEN, SCM_FOREIGN_TYPED_P,
  SCM_FOREIGN_VALUE_P, SCM_VALIDATE_FOREIGN_VALUE, scm_foreign_set_x,
  scm_foreign_type): Remove.
  (scm_foreign_ref): Rename to...
  (scm_foreign_address): ... this.
  (scm_take_foreign_pointer): Update.
  (SCM_FOREIGN_POINTER): Remove CTYPE argument.  Update callers.
  (scm_make_pointer): New declaration.

* libguile/foreign.c (scm_to_uintptr, scm_from_uintptr): New macros.
  (scm_make_pointer): New function.
  (scm_take_foreign_pointer): Remove TYPE and LEN arguments.  Update
  callers.
  (scm_foreign_ref): Remove to...
  (scm_foreign_address): ... this.  Remove type-related code.
  (scm_foreign_set_x): Remove.
  (scm_foreign_to_bytevector): Change argument order; make LEN argument
  compulsory.
  (scm_i_foreign_print): Remove type printing.
  (unpack): Remove foreign-type checking.

* libguile/deprecated.c (scm_dynamic_args_call): Update accordingly.

* libguile/dynl.c (scm_dynamic_pointer): Remove the TYPE and LEN
  arguments; update callers.  Update to the new foreign API.

* libguile/dynl.h (scm_dynamic_pointer): Update.

* libguile/gsubr.c (create_gsubr): Update to the new foreign API.

* libguile/gsubr.h (SCM_SUBRF, SCM_SUBR_GENERIC): Ditto.

* libguile/snarf.h (SCM_IMMUTABLE_FOREIGN): Ditto.

* libguile/vm-i-system.c (subr_call): Ditto.

* module/system/foreign.scm (null-pointer?): New procedure.

* test-suite/standalone/test-ffi: Update to the new
  `bytevector->foreign' signature.

* test-suite/tests/foreign.test ("null pointer")["null pointer
  identity", "null-pointer? %null-pointer"]: New tests.
  ["foreign-set! other-null-pointer", "foreign->bytevector
  other-null-pointer"]: Remove.
  ("make-pointer", "foreign<->bytevector"): New test prefixes.
This commit is contained in:
Ludovic Courtès 2010-07-26 17:44:43 +02:00
parent 1af772303b
commit d4149a510e
12 changed files with 176 additions and 307 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -23,35 +23,47 @@
(define-module (test-foreign)
#:use-module (system foreign)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (test-suite lib))
(with-test-prefix "null pointer"
(pass-if "zero"
(= 0 (foreign-ref %null-pointer)))
(= 0 (foreign-address %null-pointer)))
(pass-if-exception "foreign-set! %null-pointer"
exception:null-pointer-error
(foreign-set! %null-pointer 2))
(pass-if "null pointer identity"
(eq? %null-pointer (make-pointer 0)))
(pass-if "foreign-set! other-null-pointer"
(let ((f (bytevector->foreign (make-bytevector 2))))
(and (not (= 0 (foreign-ref f)))
(begin
(foreign-set! f 0)
(= 0 (foreign-ref f)))
(begin
;; Here changing the pointer value of F is perfectly valid.
(foreign-set! f 777)
(= 777 (foreign-ref f))))))
(pass-if "null-pointer? %null-pointer"
(null-pointer? %null-pointer))
(pass-if-exception "foreign->bytevector %null-pointer"
exception:null-pointer-error
(foreign->bytevector %null-pointer))
(foreign->bytevector %null-pointer 7)))
(pass-if-exception "foreign->bytevector other-null-pointer"
exception:null-pointer-error
(let ((f (bytevector->foreign (make-bytevector 2))))
(foreign-set! f 0)
(foreign->bytevector f))))
(with-test-prefix "make-pointer"
(pass-if "address preserved"
(= 123 (foreign-address (make-pointer 123)))))
(with-test-prefix "foreign<->bytevector"
(pass-if "bijection"
(let ((bv #vu8(0 1 2 3 4 5 6 7)))
(equal? (foreign->bytevector (bytevector->foreign bv)
(bytevector-length bv))
bv)))
(pass-if "pointer from bits"
(let* ((bytes (iota (sizeof '*)))
(bv (u8-list->bytevector bytes)))
(= (foreign-address
(make-pointer (bytevector-uint-ref bv 0 (native-endianness)
(sizeof '*))))
(fold-right (lambda (byte address)
(+ byte (* 256 address)))
0
bytes)))))