[PING] [PATCH v2] guile: fix smob exports

[George Barrett]

Pinging for review. If it looks okay, I'd appreciate if someone could push it
on my behalf.

On Mon, Jun 07, 2021 at 04:49:58AM +1000, George Barrett wrote:
> 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 <v2.1 (types are exported from (oop
> goops)) instead of (gdb)) and incorrect when linked against Guile
> v2.1+ (types are not bound to any variables at all!).
> 
> This commit makes a small change to GDB's smob registration machinery
> to make sure registered smobs get exported from the current
> module. This will likely cause warnings to the user about conflicting
> exports if they load both (gdb) and (oop goops) from a GDB linked
> against Guile v2.0, but it shouldn't impact functionality (and seemed
> preferable to trying to un-export bindings from (oop goops) if v2.0
> was detected).
> 
> [1]: This changed with Guile commit
>      28d0871b553a3959a6c59e2e4caec1c1509f8595
> 
> gdb/ChangeLog:
> 
> 2021-06-07  George Barrett  <bob@bob131.so>
> 
> 	* guile/scm-gsmob.c (gdbscm_make_smob_type): Export registered
> 	smob type from the current module.
> 
> gdb/testsuite/ChangeLog:
> 
> 2021-06-07  George Barrett  <bob@bob131.so>
> 
> 	* 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                 | 29 ++++++++++++++++++++++++++-
>  gdb/testsuite/gdb.guile/scm-gsmob.exp | 28 ++++++++++++++++++++++++++
>  2 files changed, 56 insertions(+), 1 deletion(-)
> 
> diff --git a/gdb/guile/scm-gsmob.c b/gdb/guile/scm-gsmob.c
> index c623b07d26c..72a96a781c1 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,32 @@ gdbscm_make_smob_type (const char *name, size_t size)
>    scm_t_bits result = scm_make_smob_type (name, size);
>  
>    register_gsmob (result);
> +
> +#if SCM_MAJOR_VERSION == 2 && SCM_MINOR_VERSION == 0
> +  /* Prior to Guile 2.1.0, smob classes were only exposed via exports
> +     from the (oop goops) module.  */
> +  SCM bound_name = scm_string_append (scm_list_3 (scm_from_latin1_string ("<"),
> +						  scm_from_latin1_string (name),
> +						  scm_from_latin1_string (">")));
> +  bound_name = scm_string_to_symbol (bound_name);
> +  SCM smob_type = scm_public_ref (scm_list_2 (scm_from_latin1_symbol ("oop"),
> +					      scm_from_latin1_symbol ("goops")),
> +				  bound_name);
> +#elif SCM_MAJOR_VERSION == 2 && SCM_MINOR_VERSION == 1 && SCM_MICRO_VERSION == 0
> +  /* Guile 2.1.0 doesn't provide any API for looking up smob classes.
> +     We could try allocating a fake instance and using scm_class_of,
> +     but it's probably not worth the trouble for the sake of a single
> +     development release.  */
> +#  error "Unsupported Guile version"
> +#else
> +  /* Guile 2.1.1 and above provides scm_smob_type_class.  */
> +  SCM smob_type = scm_smob_type_class (result);
> +#endif
> +
> +  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..e309fd2888d 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) (string<? (symbol->string a) (symbol->string b)))))" \
>      "= \\($prop_list\\)" "object-properties"
> +
> +# Check that smob classes are exported properly
> +with_test_prefix "test exports" {
> +    # Import (oop goops) for is-a? and <class>
> +    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) <class>))"
> +
> +    gdb_test "gu (print (gdb-exports-class? <gdb:arch>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:block>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:block-symbols-iterator>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:breakpoint>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:command>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:exception>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:frame>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:iterator>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:lazy-string>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:objfile>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:parameter>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:pretty-printer>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:pretty-printer-worker>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:progspace>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:symbol>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:symtab>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:sal>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:type>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:field>))" "= #t"
> +    gdb_test "gu (print (gdb-exports-class? <gdb:value>))" "= #t"
> +}
> -- 
> 2.31.1