mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-21 20:20:24 +02:00
Code Activity

GOOPS caches created vtables

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2016-09-02 09:43:42 +02:00
parent 0f2f5949a2
commit 2dbb0e212d
2 changed files with 12 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

2
libguile/goops.c
View file

@ -865,7 +865,7 @@ scm_i_define_class_for_vtable (SCM vtable)
supers = scm_list_1 (class_top); 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 else
/* `create_struct_classes' will fill this in later. */ /* `create_struct_classes' will fill this in later. */

12
test-suite/tests/goops.test
View file

@ -149,7 +149,17 @@
;; for which `struct-vtable-name' is #f. ;; for which `struct-vtable-name' is #f.
(is-a? (class-of (make-vtable (is-a? (class-of (make-vtable
(string-append standard-vtable-fields "prprpr"))) (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" (with-test-prefix "defining classes"