dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Raise an error when attempting to modify the value of `%null-pointer'.

Browse source 
* libguile/foreign.c (sym_null_pointer_error): New variable.
  (null_pointer_error): New function.
  (scm_foreign_set_x): Raise an error if attempting to modify
  NULL_POINTER.
  (scm_foreign_to_bytevector): Use `null_pointer_error ()' instead of
  `scm_misc_error ()'.

* test-suite/tests/foreign.test: New file.

* test-suite/Makefile.am (SCM_TESTS): Add tests/foreign.test.

* test-suite/lib.scm (exception:null-pointer-error): New variable.
This commit is contained in:
Ludovic Courtès 2010-04-09 00:30:10 +02:00
commit 01ad5a7ba9
4 changed files with 78 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

18
libguile/foreign.c
View file

@ -52,6 +52,7 @@ SCM_SYMBOL (sym_size_t, "size_t");
SCM_SYMBOL (sym_asterisk, "*");
SCM_SYMBOL (sym_null, "%null-pointer");
SCM_SYMBOL (sym_null_pointer_error, "null-pointer-error");
/* The cell representing the null pointer. */
static const scm_t_bits null_pointer[2] =
@ -60,6 +61,15 @@ static const scm_t_bits null_pointer[2] =
0
};
/* Raise a null pointer dereference error. */
static void
null_pointer_error (const char *func_name)
{
scm_error (sym_null_pointer_error, func_name,
"null pointer dereference", SCM_EOL, SCM_EOL);
}
static SCM cif_to_procedure (SCM cif, SCM func_ptr);
@ -161,6 +171,12 @@ SCM_DEFINE (scm_foreign_set_x, "foreign-set!", 2, 0, 0,
scm_t_uint8 *ptr;
SCM_VALIDATE_FOREIGN (1, foreign);
if (SCM_UNLIKELY (scm_is_eq (foreign, PTR2SCM (&null_pointer))))
/* Attempting to modify the pointer value of NULL_POINTER (which is
read-only anyway), so raise an error. */
null_pointer_error (FUNC_NAME);
ptr = SCM_FOREIGN_POINTER (foreign, scm_t_uint8);
ftype = SCM_FOREIGN_TYPE (foreign);
@ -237,7 +253,7 @@ SCM_DEFINE (scm_foreign_to_bytevector, "foreign->bytevector", 1, 3, 0,
ptr = SCM_FOREIGN_POINTER (foreign, scm_t_int8);
if (SCM_UNLIKELY (ptr == NULL))
scm_misc_error (FUNC_NAME, "null pointer dereference", SCM_EOL);
null_pointer_error (FUNC_NAME);
if (SCM_UNBNDP (uvec_type))
btype = SCM_ARRAY_ELEMENT_TYPE_VU8;