diff mbox

[4/4] Fix some aspects of python lazy string handling: scheme

Message ID 001a1134f356f7dc0a0540abd070@google.com
State New
Headers show

Commit Message

Doug Evans Nov. 7, 2016, 1:19 a.m. UTC
Hi. This is the scheme equivalent of the python fixes.

2016-11-06  Doug Evans  <dje@google.com>

	* guile/scm-lazy-string.c (lazy_string_smob): Clarify use of LENGTH
	member.  Change type of TYPE member to SCM.  All uses updated.
	(lsscm_make_lazy_string_smob): Add assert.
	(lsscm_make_lazy_string): Flag bad length values.
	(lsscm_elt_type): New function.
	(gdbscm_lazy_string_to_value): Rewrite to use
	lsscm_safe_lazy_string_to_value.
	(lsscm_safe_lazy_string_to_value): Fix handling of TYPE_CODE_PTR.
	* guile/scm-value.c (gdbscm_value_to_lazy_string): Flag bad length
	values.  Fix TYPE_CODE_PTR.  Handle TYPE_CODE_ARRAY.  Handle typedefs
	in incoming type.
	* guile/guile-internal.h (tyscm_scm_to_type): Declare.
	* guile/scm-type.c (tyscm_scm_to_type): New function.

	testsuite/
	* gdb.guile/scm-value.c (main) Delete locals sptr, sn.
	* gdb.guile/scm-lazy-string.c: New file.
	* gdb.guile/scm-value.exp: Move lazy string tests to ...
	* gdb.guile/scm-lazy-string.exp: ... here, new file.  Add more tests
	for pointer, array, typedef lazy strings.


@@ -457,7 +427,6 @@ if ![gdb_guile_runto_main] {
  test_value_in_inferior
  test_inferior_function_call
  test_strings
-test_lazy_strings
  test_value_after_death

  # Test either C or C++ values.

Comments

Doug Evans via gdb-patches March 16, 2017, 4:58 p.m. UTC | #1
On Sun, Nov 6, 2016 at 5:19 PM, Doug Evans <dje@google.com> wrote:
> Hi. This is the scheme equivalent of the python fixes.
>
> 2016-11-06  Doug Evans  <dje@google.com>
>
>         * guile/scm-lazy-string.c (lazy_string_smob): Clarify use of LENGTH
>         member.  Change type of TYPE member to SCM.  All uses updated.
>         (lsscm_make_lazy_string_smob): Add assert.
>         (lsscm_make_lazy_string): Flag bad length values.
>         (lsscm_elt_type): New function.
>         (gdbscm_lazy_string_to_value): Rewrite to use
>         lsscm_safe_lazy_string_to_value.
>         (lsscm_safe_lazy_string_to_value): Fix handling of TYPE_CODE_PTR.
>         * guile/scm-value.c (gdbscm_value_to_lazy_string): Flag bad length
>         values.  Fix TYPE_CODE_PTR.  Handle TYPE_CODE_ARRAY.  Handle
> typedefs
>         in incoming type.
>         * guile/guile-internal.h (tyscm_scm_to_type): Declare.
>         * guile/scm-type.c (tyscm_scm_to_type): New function.
>
>         testsuite/
>         * gdb.guile/scm-value.c (main) Delete locals sptr, sn.
>         * gdb.guile/scm-lazy-string.c: New file.
>         * gdb.guile/scm-value.exp: Move lazy string tests to ...
>         * gdb.guile/scm-lazy-string.exp: ... here, new file.  Add more tests
>         for pointer, array, typedef lazy strings.

Rebased, re-regression tested on amd64-linux, and committed.
[I'll post the committed patch as soon as I can get sendmail on my box
working again, bleah. We still don't allow attachments do we?]
diff mbox

Patch

diff --git a/gdb/guile/scm-lazy-string.c b/gdb/guile/scm-lazy-string.c
index 5229be4..c4e6398 100644
--- a/gdb/guile/scm-lazy-string.c
+++ b/gdb/guile/scm-lazy-string.c
@@ -44,14 +44,20 @@  typedef struct
        freed.  */
    char *encoding;

-  /* Holds the length of the string in characters.  If the length is -1,
-     then the string will be fetched and encoded up to the first null of
-     appropriate width.  */
+  /* If TYPE is an array: If the length is known, then this value is the
+     array's length, otherwise it is -1.
+     If TYPE is not an array: Then this value represents the string's  
length.
+     In either case, if the value is -1 then the string will be fetched and
+     encoded up to the first null of appropriate width.  */
    int length;

-  /*  This attribute holds the type that is represented by the lazy
-      string's type.  */
-  struct type *type;
+  /* The type of the string.
+     For example if the lazy string was created from a C "char*" then TYPE
+     represents a C "char*".  To get the type of the character in the  
string
+     call lsscm_elt_type which handles the different kinds of values for  
TYPE.
+     This is recorded as an SCM object so that we take advantage of  
support for
+     preserving the type should its owning objfile go away.  */
+  SCM type;
  } lazy_string_smob;

  static const char lazy_string_smob_name[] = "gdb:lazy-string";
@@ -95,7 +101,10 @@  lsscm_print_lazy_string_smob (SCM self, SCM port,  
scm_print_state *pstate)
  }

  /* Low level routine to create a <gdb:lazy-string> object.
-   The caller must verify !(address == 0 && length != 0).  */
+   The caller must verify:
+   - length >= -1
+   - !(address == 0 && length != 0)
+   - type != NULL */

  static SCM
  lsscm_make_lazy_string_smob (CORE_ADDR address, int length,
@@ -105,18 +114,17 @@  lsscm_make_lazy_string_smob (CORE_ADDR address, int  
length,
      scm_gc_malloc (sizeof (lazy_string_smob), lazy_string_smob_name);
    SCM ls_scm;

-  /* Caller must verify this.  */
+  gdb_assert (length >= -1);
    gdb_assert (!(address == 0 && length != 0));
    gdb_assert (type != NULL);

    ls_smob->address = address;
-  /* Coerce all values < 0 to -1.  */
-  ls_smob->length = length < 0 ? -1 : length;
+  ls_smob->length = length;
    if (encoding == NULL || strcmp (encoding, "") == 0)
      ls_smob->encoding = NULL;
    else
      ls_smob->encoding = xstrdup (encoding);
-  ls_smob->type = type;
+  ls_smob->type = tyscm_scm_from_type (type);

    ls_scm = scm_new_smob (lazy_string_smob_tag, (scm_t_bits) ls_smob);
    gdbscm_init_gsmob (&ls_smob->base);
@@ -147,11 +155,18 @@  SCM
  lsscm_make_lazy_string (CORE_ADDR address, int length,
  			const char *encoding, struct type *type)
  {
+  if (length < -1)
+    {
+      return gdbscm_make_out_of_range_error (NULL, 0,
+					     scm_from_int (length),
+					     _("invalid length"));
+    }
+
    if (address == 0 && length != 0)
      {
        return gdbscm_make_out_of_range_error
  	(NULL, 0, scm_from_int (length),
-	 _("cannot create a lazy string with address 0x0"
+	 _("cannot create a lazy string with address 0x0,"
  	   " and a non-zero length"));
      }

@@ -175,6 +190,28 @@  lsscm_get_lazy_string_arg_unsafe (SCM self, int  
arg_pos, const char *func_name)

    return self;
  }
+
+/* Return the type of a character in lazy string LS_SMOB.  */
+
+static struct type *
+lsscm_elt_type (lazy_string_smob *ls_smob)
+{
+  struct type *type = tyscm_scm_to_type (ls_smob->type);
+  struct type *realtype;
+
+  realtype = check_typedef (type);
+
+  switch (TYPE_CODE (realtype))
+    {
+    case TYPE_CODE_PTR:
+    case TYPE_CODE_ARRAY:
+      return TYPE_TARGET_TYPE (realtype);
+    default:
+      /* This is done to preserve existing behaviour.  PR 20769.
+	 E.g., gdb.parse_and_eval("my_int_variable").lazy_string().type.  */
+      return realtype;
+    }
+}
  
  /* Lazy string methods.  */

@@ -223,7 +260,7 @@  gdbscm_lazy_string_type (SCM self)
    SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1,  
FUNC_NAME);
    lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);

-  return tyscm_scm_from_type (ls_smob->type);
+  return ls_smob->type;
  }

  /* (lazy-string->value <gdb:lazy-string>) -> <gdb:value> */
@@ -232,25 +269,13 @@  static SCM
  gdbscm_lazy_string_to_value (SCM self)
  {
    SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1,  
FUNC_NAME);
-  lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
-  struct value *value = NULL;
-
-  if (ls_smob->address == 0)
-    {
-      gdbscm_throw (gdbscm_make_out_of_range_error (FUNC_NAME, SCM_ARG1,  
self,
-				_("cannot create a value from NULL")));
-    }
-
-  TRY
-    {
-      value = value_at_lazy (ls_smob->type, ls_smob->address);
-    }
-  CATCH (except, RETURN_MASK_ALL)
-    {
-      GDBSCM_HANDLE_GDB_EXCEPTION (except);
-    }
-  END_CATCH
+  SCM except_scm;
+  struct value *value;

+  value = lsscm_safe_lazy_string_to_value (ls_scm, SCM_ARG1, FUNC_NAME,
+					   &except_scm);
+  if (value == NULL)
+    gdbscm_throw (except_scm);
    return vlscm_scm_from_value (value);
  }

@@ -275,19 +300,41 @@  lsscm_safe_lazy_string_to_value (SCM string, int  
arg_pos,
    gdb_assert (lsscm_is_lazy_string (string));

    ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (string);
-  *except_scmp = SCM_BOOL_F;

    if (ls_smob->address == 0)
      {
        *except_scmp
-	= gdbscm_make_out_of_range_error (FUNC_NAME, SCM_ARG1, string,
+	= gdbscm_make_out_of_range_error (func_name, arg_pos, string,
  					 _("cannot create a value from NULL"));
        return NULL;
      }

    TRY
      {
-      value = value_at_lazy (ls_smob->type, ls_smob->address);
+      struct type *type = tyscm_scm_to_type (ls_smob->type);
+      struct type *realtype = check_typedef (type);
+
+      switch (TYPE_CODE (realtype))
+	{
+	case TYPE_CODE_PTR:
+	  /* If a length is specified we need to convert this to an array
+	     of the specified size.  */
+	  if (ls_smob->length != -1)
+	    {
+	      /* PR 20786: There's no way to specify an array of length zero.
+		 Record a length of [0,-1] which is how Ada does it.  Anything
+		 we do is broken, but this one possible solution.  */
+	      type = lookup_array_range_type (TYPE_TARGET_TYPE (realtype),
+					      0, ls_smob->length - 1);
+	      value = value_at_lazy (type, ls_smob->address);
+	    }
+	  else
+	    value = value_from_pointer (type, ls_smob->address);
+	  break;
+	default:
+	  value = value_at_lazy (type, ls_smob->address);
+	  break;
+	}
      }
    CATCH (except, RETURN_MASK_ALL)
      {
@@ -307,12 +354,14 @@  lsscm_val_print_lazy_string (SCM string, struct  
ui_file *stream,
  			     const struct value_print_options *options)
  {
    lazy_string_smob *ls_smob;
+  struct type *elt_type;

    gdb_assert (lsscm_is_lazy_string (string));

    ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (string);
+  elt_type = lsscm_elt_type (ls_smob);

-  val_print_string (ls_smob->type, ls_smob->encoding,
+  val_print_string (elt_type, ls_smob->encoding,
  		    ls_smob->address, ls_smob->length,
  		    stream, options);
  }
diff --git a/gdb/guile/scm-value.c b/gdb/guile/scm-value.c
index 1cdf953..96a1abc 100644
--- a/gdb/guile/scm-value.c
+++ b/gdb/guile/scm-value.c
@@ -1182,8 +1182,10 @@  gdbscm_value_to_string (SCM self, SCM rest)
     Return a Scheme object representing a lazy_string_object type.
     A lazy string is a pointer to a string with an optional encoding and  
length.
     If ENCODING is not given, the target's charset is used.
-   If LENGTH is provided then the length parameter is set to LENGTH,  
otherwise
-   length will be set to -1 (first null of appropriate with).
+   If LENGTH is provided then the length parameter is set to LENGTH.
+   Otherwise if the value is an array of known length then the array's  
length
+   is used.  Otherwise the length will be set to -1 (meaning first null of
+   appropriate with).
     LENGTH must be a Scheme integer, it can't be a <gdb:value> integer.  */

  static SCM
@@ -1207,18 +1209,69 @@  gdbscm_value_to_lazy_string (SCM self, SCM rest)
  			      &encoding_arg_pos, &encoding,
  			      &length_arg_pos, &length);

+  if (length < -1)
+    {
+      gdbscm_out_of_range_error (FUNC_NAME, length_arg_pos,
+				 scm_from_int (length),
+				 _("invalid length"));
+    }
+
    cleanups = make_cleanup (xfree, encoding);

    TRY
      {
        struct cleanup *inner_cleanup
  	= make_cleanup_value_free_to_mark (value_mark ());
+      struct type *type, *realtype;
+      CORE_ADDR addr;

-      if (TYPE_CODE (value_type (value)) == TYPE_CODE_PTR)
-	value = value_ind (value);
+      type = value_type (value);
+      realtype = check_typedef (type);
+
+      switch (TYPE_CODE (realtype))
+	{
+	case TYPE_CODE_ARRAY:
+	  {
+	    LONGEST array_length = -1;
+	    LONGEST low_bound, high_bound;
+
+	    /* PR 20786: There's no way to specify an array of length zero.
+	       Record a length of [0,-1] which is how Ada does it.  Anything
+	       we do is broken, but this one possible solution.  */
+	    if (get_array_bounds (realtype, &low_bound, &high_bound))
+	      array_length = high_bound - low_bound + 1;
+	    if (length == -1)
+	      length = array_length;
+	    else if (array_length == -1)
+	      {
+		type = lookup_array_range_type (TYPE_TARGET_TYPE (realtype),
+						0, length - 1);
+	      }
+	    else if (length != array_length)
+	      {
+		/* We need to create a new array type with the
+		   specified length.  */
+		if (length > array_length)
+		  error (_("length is larger than array size"));
+		type = lookup_array_range_type (TYPE_TARGET_TYPE (type),
+						low_bound,
+						low_bound + length - 1);
+	      }
+	    addr = value_address (value);
+	    break;
+	  }
+	case TYPE_CODE_PTR:
+	  /* If a length is specified we defer creating an array of the
+	     specified width until we need to.  */
+	  addr = value_as_address (value);
+	  break;
+	default:
+	  /* Should flag an error here.  PR 20769.  */
+	  addr = value_address (value);
+	  break;
+	}

-      result = lsscm_make_lazy_string (value_address (value), length,
-				       encoding, value_type (value));
+      result = lsscm_make_lazy_string (addr, length, encoding, type);

        do_cleanups (inner_cleanup);
      }
diff --git a/gdb/testsuite/gdb.guile/scm-lazy-string.c  
b/gdb/testsuite/gdb.guile/scm-lazy-string.c
new file mode 100644
index 0000000..936b4e2
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-lazy-string.c
@@ -0,0 +1,29 @@ 
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 2015-2016 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.   
*/
+
+typedef const char *pointer;
+
+int
+main ()
+{
+  const char *ptr = "pointer";
+  const char array[] = "array";
+  pointer typedef_ptr = "typedef pointer";
+  const char *null = 0;
+
+  return 0; /* break here */
+}
diff --git a/gdb/testsuite/gdb.guile/scm-lazy-string.exp  
b/gdb/testsuite/gdb.guile/scm-lazy-string.exp
new file mode 100644
index 0000000..a3ab441
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-lazy-string.exp
@@ -0,0 +1,82 @@ 
+# Copyright (C) 2008-2016 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# This file is part of the GDB testsuite.
+# It tests the mechanism exposing lazy strings to Guile.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile}] } {
+    return
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+#gdb_install_guile_utils
+#gdb_install_guile_module
+
+# The following tests require execution.
+
+if ![gdb_guile_runto_main] {
+    fail "Can't run to main"
+    return
+}
+
+gdb_breakpoint [gdb_get_line_number "break here"]
+gdb_continue_to_breakpoint "break here"
+
+gdb_scm_test_silent_cmd "gu (define null (parse-and-eval \"null\"))" 1
+
+gdb_scm_test_silent_cmd "gu (define nullstr (value->lazy-string null  
#:length 0))" "create a null lazy string" 1
+gdb_test "gu (print (lazy-string-length nullstr))" "= 0" "null lazy string  
length"
+gdb_test "gu (print (lazy-string-address nullstr))" "= 0" "null lazy  
string address"
+gdb_test "gu (print (lazy-string-type nullstr))" "const char \\*" "null  
lazy string type"
+gdb_test "gu (print (lazy-string->value nullstr))" \
+    "Out of range: cannot create a value from NULL.*Error while executing  
Scheme code." \
+    "create value from NULL"
+gdb_test "gu (print (lazy-string->value (value->lazy-string null #:length  
3)))" \
+    "Out of range: cannot create a lazy string with address 0x0, and a  
non-zero length.*Error while executing Scheme code." \
+    "null lazy string with non-zero length"
+gdb_test "gu (print (value->lazy-string null #:length -2))" \
+    "Out of range: invalid length.*Error while executing Scheme code." \
+    "bad length"
+
+foreach var_spec { { "ptr" "pointer" "const char \\*" -1 } \
+		   { "array" "array" "const char \\[6\\]" 6 } \
+		   { "typedef_ptr" "typedef pointer" "pointer" -1 } } {
+    set var [lindex $var_spec 0]
+    set value [lindex $var_spec 1]
+    set type [lindex $var_spec 2]
+    set length [lindex $var_spec 3]
+    with_test_prefix $var {
+	gdb_test "print $var" "\"$value\""
+	gdb_scm_test_silent_cmd "gu (define $var (history-ref 0))" "get value  
from history" 1
+	gdb_scm_test_silent_cmd "gu (define l$var (value->lazy-string  
$var))" "acquire lazy string" 1
+	gdb_test "gu (print (value-type $var))" "$type" "string type name  
equality"
+	gdb_test "gu (print (lazy-string-type l$var))" "$type" "lazy-string type  
name equality"
+	gdb_test "gu (print (lazy-string-length l$var))" "$length" "lazy string  
length"
+	gdb_test "gu (print (lazy-string->value l$var))" "\"$value\"" "lazy  
string value"
+	gdb_scm_test_silent_cmd "gu (define l2$var (value->lazy-string $var  
#:length 2))" "acquire lazy string, length 2" 1
+	gdb_test "gu (print (lazy-string-length l2$var))" "2" "lazy string length  
2"
+	gdb_test "gu (print (lazy-string->value l2$var))" "\"[string range $value  
0 1]\"" "lazy string length 2 value"
+	# This test will have to wait until gdb can handle it. There's no way,
+	# currently, to internally specify an array of length zero in the C
+	# language support.  PR 20786
+	#gdb_test "gu (print (lazy-string->value (value->lazy-string $var  
#:length 0)))" "\"\"" "empty lazy string value"
+    }
+}
diff --git a/gdb/testsuite/gdb.guile/scm-value.c  
b/gdb/testsuite/gdb.guile/scm-value.c
index 6d8254f..3597a6d 100644
--- a/gdb/testsuite/gdb.guile/scm-value.c
+++ b/gdb/testsuite/gdb.guile/scm-value.c
@@ -81,13 +81,11 @@  main (int argc, char *argv[])
    char nullst[17] = "divide\0et\0impera";
    void (*fp1) (void)  = &func1;
    int  (*fp2) (int, int) = &func2;
-  const char *sptr = "pointer";
    const char *embed = "embedded x\201\202\203\204";
    int a[3] = {1,2,3};
    int *p = a;
    int i = 2;
    int *ptr_i = &i;
-  const char *sn = 0;
    s.a = 3;
    s.b = 5;
    u.a = 7;
diff --git a/gdb/testsuite/gdb.guile/scm-value.exp  
b/gdb/testsuite/gdb.guile/scm-value.exp
index 1d07c9f..ae6e1fd 100644
--- a/gdb/testsuite/gdb.guile/scm-value.exp
+++ b/gdb/testsuite/gdb.guile/scm-value.exp
@@ -213,36 +213,6 @@  proc test_strings {} {
  	"restore target-charset"
  }

-proc test_lazy_strings {} {
-    global hex
-
-    gdb_test "print sptr" "\"pointer\""
-    gdb_scm_test_silent_cmd "gu (define sptr (history-ref 0))" \
-	"lazy strings: get sptr value from history"
-
-    gdb_scm_test_silent_cmd "gu (define lstr (value->lazy-string sptr))" \
-	"Aquire lazy string"
-    gdb_test "gu (print (lazy-string-type lstr))" \
-	"= const char \*." "Test lazy-string type name equality"
-    gdb_test "gu (print (value-type sptr))" \
-	"= const char \*." "Test string type name equality"
-
-    # Prevent symbol on address 0x0 being printed.
-    gdb_test_no_output "set print symbol off"
-    gdb_test "print sn" "0x0"
-
-    gdb_scm_test_silent_cmd "gu (define snptr (history-ref 0))" \
-	"lazy strings: get snptr value from history"
-    gdb_test "gu (define snstr (value->lazy-string snptr #:length 5))" \
-	".*cannot create a lazy string with address.*" "Test lazy string"
-    gdb_scm_test_silent_cmd "gu (define snstr (value->lazy-string snptr  
#:length 0))" \
-	"Successfully create a lazy string"
-    gdb_test "gu (print (lazy-string-length snstr))" \
-	"= 0" "Test lazy string length"
-    gdb_test "gu (print (lazy-string-address snstr))" \
-	"= 0" "Test lazy string address"
-}
-
  proc test_inferior_function_call {} {
      global gdb_prompt hex decimal