From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail.bob131.so (server2.bob131.so [128.199.153.143]) by sourceware.org (Postfix) with ESMTPS id AF4A53947C0D for ; Wed, 19 May 2021 22:27:54 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org AF4A53947C0D Received: from internal.mail.bob131.so (localhost [127.0.0.1]) by mail.bob131.so (Postfix) with ESMTP id 14D8A53FBA; Wed, 19 May 2021 22:27:52 +0000 (UTC) DKIM-Filter: OpenDKIM Filter v2.11.0 mail.bob131.so 14D8A53FBA Date: Thu, 20 May 2021 08:27:50 +1000 From: George Barrett To: gdb-patches@sourceware.org Cc: George Barrett Subject: [PATCH] guile: fix smob exports Message-ID: MIME-Version: 1.0 Content-Type: text/plain; charset="us-ascii" Content-Disposition: inline X-Spam-Status: No, score=-11.9 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gdb-patches@sourceware.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 19 May 2021 22:27:56 -0000 Before Guile v2.1[1], calls to `scm_make_smob_type' implicitly added the created class to the exports list of (oop goops); v2.1+ does not implicitly create bindings in any modules. This means that the GDB manual subsection documenting exported types is not quite right when GDB is linked against Guile * guile/scm-gsmob.c (gdbscm_make_smob_type): Export registered smob type from the current module. gdb/testsuite/ChangeLog: 2021-05-20 George Barrett * gdb.guile/scm-gsmob.exp (test exports): Add tests to make sure the smob types currently listed in the GDB manual get exported from the (gdb) module. --- gdb/guile/scm-gsmob.c | 9 ++++++++- gdb/testsuite/gdb.guile/scm-gsmob.exp | 28 +++++++++++++++++++++++++++ 2 files changed, 36 insertions(+), 1 deletion(-) diff --git a/gdb/guile/scm-gsmob.c b/gdb/guile/scm-gsmob.c index c623b07d26c..a8ab63a67b5 100644 --- a/gdb/guile/scm-gsmob.c +++ b/gdb/guile/scm-gsmob.c @@ -96,7 +96,8 @@ gdbscm_is_gsmob (SCM scm) return slot != NULL; } -/* Call this to register a smob, instead of scm_make_smob_type. */ +/* Call this to register a smob, instead of scm_make_smob_type. + Exports the created smob type from the current module. */ scm_t_bits gdbscm_make_smob_type (const char *name, size_t size) @@ -104,6 +105,12 @@ gdbscm_make_smob_type (const char *name, size_t size) scm_t_bits result = scm_make_smob_type (name, size); register_gsmob (result); + + SCM smob_type = scm_smob_type_class (result); + SCM smob_type_name = scm_class_name (smob_type); + scm_define (smob_type_name, smob_type); + scm_module_export (scm_current_module (), scm_list_1 (smob_type_name)); + return result; } diff --git a/gdb/testsuite/gdb.guile/scm-gsmob.exp b/gdb/testsuite/gdb.guile/scm-gsmob.exp index 90c32df7dda..d2a77198a23 100644 --- a/gdb/testsuite/gdb.guile/scm-gsmob.exp +++ b/gdb/testsuite/gdb.guile/scm-gsmob.exp @@ -66,3 +66,31 @@ set prop_list [lsort $prop_list] verbose -log "prop_list: $prop_list" gdb_test "gu (print (sort (map car (object-properties arch)) (lambda (a b) (stringstring a) (symbol->string b)))))" \ "= \\($prop_list\\)" "object-properties" + +# Check that smob classes are exported properly +with_test_prefix "test exports" { + # For is-a? and + gdb_scm_test_silent_cmd "gu (use-modules (oop goops))" "import goops" + gdb_test_no_output "gu (define-syntax-rule (gdb-exports-class? x) (is-a? (@ (gdb) x) ))" + + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" + gdb_test "gu (print (gdb-exports-class? ))" "= #t" +} -- 2.31.1