From 2dbb0e212d76f08be6cd36a7b917b00deeb367cb Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 2 Sep 2016 09:43:42 +0200 Subject: [PATCH] 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 88a065fd2..3ed60d3f3 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 087b6a90a..730aabb31 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"))) - ))) + )) + + ;; 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"