mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

check layout when making vtables

Browse source 
* libguile/struct.c (scm_is_valid_vtable_layout): New private layout
  validating function.
  (scm_i_struct_inherit_vtable_magic): Do a more proper layout
  validation, and don't abort.
This commit is contained in:
Andy Wingo 2010-05-04 23:20:12 +02:00
parent 42a710680d
commit 631237b46c
1 changed files with 42 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

44
libguile/struct.c
View file

@ -203,6 +203,46 @@ set_vtable_layout_flags (SCM vtable)
}
}
static int
scm_is_valid_vtable_layout (SCM layout)
{
size_t len, n;
const char *c_layout;
c_layout = scm_i_symbol_chars (layout);
len = scm_i_symbol_length (layout);
if (len % 2)
return 0;
for (n = 0; n < len; n += 2)
switch (c_layout[n])
{
case 'u':
case 'p':
case 's':
switch (c_layout[n+1])
{
case 'W':
case 'R':
case 'O':
if (n + 2 != len)
return 0;
case 'w':
case 'h':
case 'r':
case 'o':
break;
default:
return 0;
}
break;
default:
return 0;
}
return 1;
}
/* Have OBJ, a newly created vtable, inherit flags from VTABLE. VTABLE is a
vtable-vtable and OBJ is an instance of VTABLE. */
void
@ -219,8 +259,8 @@ scm_i_struct_inherit_vtable_magic (SCM vtable, SCM obj)
SCM olayout;
/* Verify that OBJ is a valid vtable. */
if (scm_is_false (scm_symbol_p (SCM_VTABLE_LAYOUT (obj))))
scm_misc_error (FUNC_NAME, "invalid layout for new vtable",
if (! scm_is_valid_vtable_layout (SCM_VTABLE_LAYOUT (obj)))
scm_misc_error (FUNC_NAME, "invalid layout for new vtable: ~a",
scm_list_1 (SCM_VTABLE_LAYOUT (obj)));
set_vtable_layout_flags (obj);