From 631237b46cde38bb2b1bb450b0db8e9664a28cb7 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Tue, 4 May 2010 23:20:12 +0200
Subject: [PATCH] check layout when making vtables

* 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.
---
 libguile/struct.c | 44 ++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 42 insertions(+), 2 deletions(-)

diff --git a/libguile/struct.c b/libguile/struct.c
index 5b1213cb2..e00b526e2 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -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);