[binutils-gdb] Guile: add value-const-value

[Andrew Burgess]

https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;h=ee35ce8200dcd1754061d5dc90fb53f9504c6394

commit ee35ce8200dcd1754061d5dc90fb53f9504c6394
Author: George Barrett <bob@bob131.so>
Date:   Thu Apr 29 03:32:56 2021 +1000

    Guile: add value-const-value
    
    The Guile API doesn't currently have an equivalent to the Python API's
    gdb.Value.const_value(). This commit adds a procedure with equivalent
    semantics to the Guile API.
    
    gdb/ChangeLog:
    
            * NEWS (Guile API): Note the addition of the new procedure.
            * guile/scm-value.c (gdbscm_value_const_value): Add
            implementation of value-const-value procedure.
            (value_functions): Add value-const-value procedure.
    
    gdb/doc/ChangeLog:
    
            * guile.texi (Values From Inferior In Guile): Add documentation
            for value-const-value.
    
    gdb/testsuite/ChangeLog:
    
            * gdb.guile/scm-value.exp (test_value_in_inferior): Add test for
            value-const-value.

Diff:
---
 gdb/ChangeLog                         |  7 +++++++
 gdb/NEWS                              |  5 +++--
 gdb/doc/ChangeLog                     |  5 +++++
 gdb/doc/guile.texi                    |  5 +++++
 gdb/guile/scm-value.c                 | 23 +++++++++++++++++++++++
 gdb/testsuite/ChangeLog               |  5 +++++
 gdb/testsuite/gdb.guile/scm-value.exp |  3 +++
 7 files changed, 51 insertions(+), 2 deletions(-)

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index f29f60a7d62..8ef5eb6c833 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,10 @@
+2021-05-12  George Barrett  <bob@bob131.so>
+
+	* NEWS (Guile API): Note the addition of the new procedure.
+	* guile/scm-value.c (gdbscm_value_const_value): Add
+	implementation of value-const-value procedure.
+	(value_functions): Add value-const-value procedure.
+
 2021-05-12  George Barrett  <bob@bob131.so>
 
 	* NEWS (Guile API): Note the addition of new procedures.
diff --git a/gdb/NEWS b/gdb/NEWS
index f7844e5d9e3..6e147cb0318 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -207,8 +207,9 @@ QMemTags
      value-referenced-value procedure now handles rvalue reference
      values.
 
-  ** New procedures for obtaining reference values:
-     value-reference-value and value-rvalue-reference-value.
+  ** New procedures for obtaining value variants:
+     value-reference-value, value-rvalue-reference-value and
+     value-const-value.
 
 *** Changes in GDB 10
 
diff --git a/gdb/doc/ChangeLog b/gdb/doc/ChangeLog
index 029e2404470..290ad485521 100644
--- a/gdb/doc/ChangeLog
+++ b/gdb/doc/ChangeLog
@@ -1,3 +1,8 @@
+2021-05-12  George Barrett  <bob@bob131.so>
+
+	* guile.texi (Values From Inferior In Guile): Add documentation
+	for value-const-value.
+
 2021-05-12  George Barrett  <bob@bob131.so>
 
 	* guile.texi (Values From Inferior In Guile): Add documentation
diff --git a/gdb/doc/guile.texi b/gdb/doc/guile.texi
index cca3a943c61..c7e43c8d63a 100644
--- a/gdb/doc/guile.texi
+++ b/gdb/doc/guile.texi
@@ -811,6 +811,11 @@ Return a new @code{<gdb:value>} object which is an rvalue reference to
 the value encapsulated by @code{<gdb:value>} object @var{value}.
 @end deffn
 
+@deffn {Scheme Procedure} value-const-value value
+Return a new @code{<gdb:value>} object which is a @samp{const} version
+of @code{<gdb:value>} object @var{value}.
+@end deffn
+
 @deffn {Scheme Procedure} value-field value field-name
 Return field @var{field-name} from @code{<gdb:value>} object @var{value}.
 @end deffn
diff --git a/gdb/guile/scm-value.c b/gdb/guile/scm-value.c
index a07bc7d2e61..24bb5547957 100644
--- a/gdb/guile/scm-value.c
+++ b/gdb/guile/scm-value.c
@@ -520,6 +520,24 @@ gdbscm_value_rvalue_reference_value (SCM self)
   return gdbscm_reference_value (self, TYPE_CODE_RVALUE_REF);
 }
 
+/* (value-const-value <gdb:value>) -> <gdb:value> */
+
+static SCM
+gdbscm_value_const_value (SCM self)
+{
+  value_smob *v_smob
+    = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+  struct value *value = v_smob->value;
+
+  return gdbscm_wrap ([=]
+    {
+      scoped_value_mark free_values;
+
+      struct value *res_val = make_cv_value (1, 0, value);
+      return vlscm_scm_from_value (res_val);
+    });
+}
+
 /* (value-type <gdb:value>) -> <gdb:type> */
 
 static SCM
@@ -1394,6 +1412,11 @@ Return a <gdb:value> object which is a reference to the given value." },
     "\
 Return a <gdb:value> object which is an rvalue reference to the given value." },
 
+  { "value-const-value", 1, 0, 0,
+    as_a_scm_t_subr (gdbscm_value_const_value),
+    "\
+Return a <gdb:value> object which is a 'const' version of the given value." },
+
   { "value-field", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_field),
     "\
 Return the specified field of the value.\n\
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 691e83cdc94..e0f64965d94 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2021-05-12  George Barrett  <bob@bob131.so>
+
+	* gdb.guile/scm-value.exp (test_value_in_inferior): Add test for
+	value-const-value.
+
 2021-05-12  George Barrett  <bob@bob131.so>
 
 	* gdb.guile/scm-value.exp (test_value_in_inferior): Add test for
diff --git a/gdb/testsuite/gdb.guile/scm-value.exp b/gdb/testsuite/gdb.guile/scm-value.exp
index b3f785c9ecf..982b9bf17b9 100644
--- a/gdb/testsuite/gdb.guile/scm-value.exp
+++ b/gdb/testsuite/gdb.guile/scm-value.exp
@@ -183,6 +183,9 @@ proc test_value_in_inferior {} {
 	"test value-rvalue-reference-value"
     gdb_test "gu (equal? argv (value-referenced-value argv-rref))" "#t"
     gdb_test "gu (eqv? (type-code (value-type argv-rref)) TYPE_CODE_RVALUE_REF)" "#t"
+
+    gdb_test "gu (equal? (value-type (value-const-value argv)) (type-const (value-type argv)))" \
+	"#t"
 }
 
 proc test_strings {} {