guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 01/01: GOOPS caches created vtables


From: Andy Wingo
Subject: [Guile-commits] 01/01: GOOPS caches created vtables
Date: Fri, 2 Sep 2016 07:44:46 +0000 (UTC)

wingo pushed a commit to branch master
in repository guile.

commit 2dbb0e212d76f08be6cd36a7b917b00deeb367cb
Author: Andy Wingo <address@hidden>
Date:   Fri Sep 2 09:43:42 2016 +0200

    GOOPS caches created vtables
    
    * libguile/goops.c (scm_i_define_class_for_vtable): Cache created
      vtables.  Fixes #24286.
    * test-suite/tests/goops.test ("classes for built-in types"): Add
      tests.
---
 libguile/goops.c            |    2 +-
 test-suite/tests/goops.test |   12 +++++++++++-
 2 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/libguile/goops.c b/libguile/goops.c
index 88a065f..3ed60d3 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -865,7 +865,7 @@ scm_i_define_class_for_vtable (SCM vtable)
               supers = scm_list_1 (class_top);
             }
 
-          return scm_make_standard_class (meta, name, supers, SCM_EOL);
+          class = scm_make_standard_class (meta, name, supers, SCM_EOL);
         }
       else
         /* `create_struct_classes' will fill this in later.  */
diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test
index 087b6a9..730aabb 100644
--- a/test-suite/tests/goops.test
+++ b/test-suite/tests/goops.test
@@ -149,7 +149,17 @@
     ;; for which `struct-vtable-name' is #f.
     (is-a? (class-of (make-vtable
                       (string-append standard-vtable-fields "prprpr")))
-           <class>)))
+           <class>))
+
+  ;; Two cases: one for structs created before goops, one after.
+  (pass-if "early vtable class cached"
+    (eq? (class-of (current-module))
+         (class-of (current-module))))
+  (pass-if "late vtable class cached"
+    (let ((vtable (make-vtable
+                   (string-append standard-vtable-fields "prprpr"))))
+      (eq? (class-of vtable)
+           (class-of vtable)))))
 
 
 (with-test-prefix "defining classes"



reply via email to

[Prev in Thread] Current Thread [Next in Thread]