Copy lazy string handling fixes from Python.

This patch keeps the Scheme side of lazy string handling in sync
with the python size, bringing over fixes for
PRs python/17728, python/18439, python/18779.

gdb/ChangeLog:

	* 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.

gdb/testsuite/ChangeLog:

	* 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.

4 files changed, 111 insertions, 33 deletions

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 0000000000..936b4e2b25
--- /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 0000000000..a3ab4419c1
--- /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 d4fd369185..80385c7a2c 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 b3c236c656..2a276124b3 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
 
@@ -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.