aboutsummaryrefslogtreecommitdiff
path: root/gdb
diff options
context:
space:
mode:
authorDoug Evans <xdje42@gmail.com>2015-05-16 12:14:26 -0700
committerDoug Evans <xdje42@gmail.com>2015-05-16 12:14:26 -0700
commit37442ce10aaa2f84d245631d38e25ee47e5057aa (patch)
treef3ca51f86a4e0a5a4c58b571ea9b49986cff4311 /gdb
parentd976bace1c68aed43311651c1033c23b3c983094 (diff)
downloadgdb-37442ce10aaa2f84d245631d38e25ee47e5057aa.zip
gdb-37442ce10aaa2f84d245631d38e25ee47e5057aa.tar.gz
gdb-37442ce10aaa2f84d245631d38e25ee47e5057aa.tar.bz2
Add support for unbuffered and zero sized Guile ports.
gdb/ChangeLog * NEWS: Mention support for unbuffered Guile memory ports. * scm-ports.c (ioscm_memory_port): Update comments on end, size. (ioscm_lseek_address): Improve overflow calculation. (gdbscm_memory_port_fill_input): Add assert. (gdbscm_memory_port_write): Handle unbuffered ports. Handle large writes identical to Guile's fport_write. (gdbscm_memory_port_seek): Fix seeking past end check. (gdbscm_memory_port_close): Handle closing unbuffered port. (ioscm_parse_mode_bits): Recognize "0" for unbuffered ports. (ioscm_init_memory_port): Handle unbuffered ports. (ioscm_reinit_memory_port): Ditto. (ioscm_init_memory_port): Update size calculation. (gdbscm_open_memory): Support zero sized ports. gdb/testsuite/ChangeLog * gdb.guile/scm-ports.c: New file. * gdb.guile/scm-ports.exp: Add memory port tests. gdb/doc/ChangeLog * guile.texi (Memory Ports in Guile): Document support for unbuffered memory ports.
Diffstat (limited to 'gdb')
-rw-r--r--gdb/ChangeLog16
-rw-r--r--gdb/NEWS4
-rw-r--r--gdb/doc/ChangeLog5
-rw-r--r--gdb/doc/guile.texi12
-rw-r--r--gdb/guile/scm-ports.c176
-rw-r--r--gdb/testsuite/ChangeLog5
-rw-r--r--gdb/testsuite/gdb.guile/scm-ports.c22
-rw-r--r--gdb/testsuite/gdb.guile/scm-ports.exp136
8 files changed, 304 insertions, 72 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 500eae1..73a423d 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,19 @@
+2015-05-16 Doug Evans <xdje42@gmail.com>
+
+ * NEWS: Mention support for unbuffered Guile memory ports.
+ * scm-ports.c (ioscm_memory_port): Update comments on end, size.
+ (ioscm_lseek_address): Improve overflow calculation.
+ (gdbscm_memory_port_fill_input): Add assert.
+ (gdbscm_memory_port_write): Handle unbuffered ports.
+ Handle large writes identical to Guile's fport_write.
+ (gdbscm_memory_port_seek): Fix seeking past end check.
+ (gdbscm_memory_port_close): Handle closing unbuffered port.
+ (ioscm_parse_mode_bits): Recognize "0" for unbuffered ports.
+ (ioscm_init_memory_port): Handle unbuffered ports.
+ (ioscm_reinit_memory_port): Ditto.
+ (ioscm_init_memory_port): Update size calculation.
+ (gdbscm_open_memory): Support zero sized ports.
+
2015-05-16 Jan Kratochvil <jan.kratochvil@redhat.com>
* compile/compile-object-load.c (get_out_value_type): Fix uninitialized
diff --git a/gdb/NEWS b/gdb/NEWS
index d27beaa..e08dd0d 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -48,6 +48,10 @@
* GDB now supports the vector ABI on S/390 GNU/Linux targets.
+* Guile Scripting
+
+ ** Memory ports can now be unbuffered.
+
* Python Scripting
** gdb.Objfile objects have a new attribute "username",
diff --git a/gdb/doc/ChangeLog b/gdb/doc/ChangeLog
index 10bb579..f8b0487 100644
--- a/gdb/doc/ChangeLog
+++ b/gdb/doc/ChangeLog
@@ -1,3 +1,8 @@
+2015-05-16 Doug Evans <xdje42@gmail.com>
+
+ * guile.texi (Memory Ports in Guile): Document support for unbuffered
+ memory ports.
+
2015-05-16 Jan Kratochvil <jan.kratochvil@redhat.com>
* gdb.texinfo (Compiling and Injecting Code): Add compile print.
diff --git a/gdb/doc/guile.texi b/gdb/doc/guile.texi
index 04572fd..a0147c1 100644
--- a/gdb/doc/guile.texi
+++ b/gdb/doc/guile.texi
@@ -3525,11 +3525,13 @@ returns a port object. One can then read/write memory using that object.
@deffn {Scheme Procedure} open-memory @r{[}#:mode mode{]} @r{[}#:start address{]} @r{[}#:size size{]}
Return a port object that can be used for reading and writing memory.
The port will be open according to @var{mode}, which is the standard
-mode argument to Guile port open routines, except that it is
-restricted to one of @samp{"r"}, @samp{"w"}, or @samp{"r+"}. For
-compatibility @samp{"b"} (binary) may also be present, but we ignore
-it: memory ports are binary only. The default is @samp{"r"},
-read-only.
+mode argument to Guile port open routines, except that the @samp{"a"}
+and @samp{"l"} modes are not supported.
+@xref{File Ports,,, guile, GNU Guile Reference Manual}.
+The @samp{"b"} (binary) character may be present, but is ignored:
+memory ports are binary only. If @samp{"0"} is appended then
+the port is marked as unbuffered.
+The default is @samp{"r"}, read-only and buffered.
The chunk of memory that can be accessed can be bounded.
If both @var{start} and @var{size} are unspecified, all of memory can be
diff --git a/gdb/guile/scm-ports.c b/gdb/guile/scm-ports.c
index 8967b92..622507b 100644
--- a/gdb/guile/scm-ports.c
+++ b/gdb/guile/scm-ports.c
@@ -47,13 +47,11 @@ typedef struct
typedef struct
{
- /* Bounds of memory range this port is allowed to access, inclusive.
- To simplify overflow handling, an END of 0xff..ff is not allowed.
- This also means a start address of 0xff..ff is also not allowed.
- I can live with that. */
+ /* Bounds of memory range this port is allowed to access: [start, end).
+ This means that 0xff..ff is not accessible. I can live with that. */
CORE_ADDR start, end;
- /* (end - start + 1), recorded for convenience. */
+ /* (end - start), recorded for convenience. */
ULONGEST size;
/* Think of this as the lseek value maintained by the kernel.
@@ -595,7 +593,7 @@ ioscm_lseek_address (ioscm_memory_port *iomem, LONGEST offset, int whence)
case SEEK_CUR:
/* Catch over/underflow. */
if ((offset < 0 && iomem->current + offset > iomem->current)
- || (offset >= 0 && iomem->current + offset < iomem->current))
+ || (offset > 0 && iomem->current + offset < iomem->current))
return 0;
new_current = iomem->current + offset;
break;
@@ -630,7 +628,8 @@ gdbscm_memory_port_fill_input (SCM port)
size_t to_read;
/* "current" is the offset of the first byte we want to read. */
- if (iomem->current >= iomem->size)
+ gdb_assert (iomem->current <= iomem->size);
+ if (iomem->current == iomem->size)
return EOF;
/* Don't read outside the allowed memory range. */
@@ -642,9 +641,9 @@ gdbscm_memory_port_fill_input (SCM port)
to_read) != 0)
gdbscm_memory_error (FUNC_NAME, _("error reading memory"), SCM_EOL);
+ iomem->current += to_read;
pt->read_pos = pt->read_buf;
pt->read_end = pt->read_buf + to_read;
- iomem->current += to_read;
return *pt->read_buf;
}
@@ -719,13 +718,6 @@ gdbscm_memory_port_write (SCM port, const void *data, size_t size)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
- const char *input = (char *) data;
-
- /* We could get fancy here, and try to buffer the request since we're
- buffering anyway. But there's currently no need. */
-
- /* First flush what's currently buffered. */
- gdbscm_memory_port_flush (port);
/* There's no way to indicate a short write, so if the request goes past
the end of the port's memory range, flag an error. */
@@ -735,10 +727,54 @@ gdbscm_memory_port_write (SCM port, const void *data, size_t size)
_("writing beyond end of memory range"));
}
- if (target_write_memory (iomem->start + iomem->current, data, size) != 0)
- gdbscm_memory_error (FUNC_NAME, _("error writing memory"), SCM_EOL);
+ if (pt->write_buf == &pt->shortbuf)
+ {
+ /* Unbuffered port. */
+ if (target_write_memory (iomem->start + iomem->current, data, size) != 0)
+ gdbscm_memory_error (FUNC_NAME, _("error writing memory"), SCM_EOL);
+ iomem->current += size;
+ return;
+ }
+
+ /* Note: The edge case of what to do when the buffer exactly fills is
+ debatable. Guile flushes when the buffer exactly fills up, so we
+ do too. It's counter-intuitive to my mind, but in case there's a
+ subtlety somewhere that depends on this, we do the same. */
+
+ {
+ size_t space = pt->write_end - pt->write_pos;
+
+ if (size < space)
+ {
+ /* Data fits in buffer, and does not fill it. */
+ memcpy (pt->write_pos, data, size);
+ pt->write_pos += size;
+ }
+ else
+ {
+ memcpy (pt->write_pos, data, space);
+ pt->write_pos = pt->write_end;
+ gdbscm_memory_port_flush (port);
+ {
+ const void *ptr = ((const char *) data) + space;
+ size_t remaining = size - space;
- iomem->current += size;
+ if (remaining >= pt->write_buf_size)
+ {
+ if (target_write_memory (iomem->start + iomem->current, ptr,
+ remaining) != 0)
+ gdbscm_memory_error (FUNC_NAME, _("error writing memory"),
+ SCM_EOL);
+ iomem->current += remaining;
+ }
+ else
+ {
+ memcpy (pt->write_pos, ptr, remaining);
+ pt->write_pos += remaining;
+ }
+ }
+ }
+ }
}
/* "seek" method for memory ports. */
@@ -768,7 +804,7 @@ gdbscm_memory_port_seek (SCM port, scm_t_off offset, int whence)
size_t delta = pt->write_pos - pt->write_buf;
if (current + delta < current
- || current + delta > iomem->size + 1)
+ || current + delta > iomem->size)
rc = 0;
else
{
@@ -845,8 +881,10 @@ gdbscm_memory_port_close (SCM port)
if (pt->read_buf == pt->putback_buf)
pt->read_buf = pt->saved_read_buf;
- xfree (pt->read_buf);
- xfree (pt->write_buf);
+ if (pt->read_buf != &pt->shortbuf)
+ xfree (pt->read_buf);
+ if (pt->write_buf != &pt->shortbuf)
+ xfree (pt->write_buf);
scm_gc_free (iomem, sizeof (*iomem), "memory port");
return 0;
@@ -915,6 +953,7 @@ ioscm_parse_mode_bits (const char *func_name, const char *mode)
{
switch (*p)
{
+ case '0':
case 'b':
case '+':
break;
@@ -933,9 +972,8 @@ ioscm_parse_mode_bits (const char *func_name, const char *mode)
}
/* Helper for gdbscm_open_memory to finish initializing the port.
- The port has address range [start,end].
- To simplify overflow handling, an END of 0xff..ff is not allowed.
- This also means a start address of 0xff..f is also not allowed.
+ The port has address range [start,end).
+ This means that address of 0xff..ff is not accessible.
I can live with that. */
static void
@@ -943,29 +981,45 @@ ioscm_init_memory_port (SCM port, CORE_ADDR start, CORE_ADDR end)
{
scm_t_port *pt;
ioscm_memory_port *iomem;
+ int buffered = (SCM_CELL_WORD_0 (port) & SCM_BUF0) == 0;
gdb_assert (start <= end);
- gdb_assert (end < ~(CORE_ADDR) 0);
iomem = (ioscm_memory_port *) scm_gc_malloc_pointerless (sizeof (*iomem),
"memory port");
iomem->start = start;
iomem->end = end;
- iomem->size = end - start + 1;
+ iomem->size = end - start;
iomem->current = 0;
- iomem->read_buf_size = default_read_buf_size;
- iomem->write_buf_size = default_write_buf_size;
+ if (buffered)
+ {
+ iomem->read_buf_size = default_read_buf_size;
+ iomem->write_buf_size = default_write_buf_size;
+ }
+ else
+ {
+ iomem->read_buf_size = 1;
+ iomem->write_buf_size = 1;
+ }
pt = SCM_PTAB_ENTRY (port);
/* Match the expectation of `binary-port?'. */
pt->encoding = NULL;
pt->rw_random = 1;
pt->read_buf_size = iomem->read_buf_size;
- pt->read_buf = xmalloc (pt->read_buf_size);
- pt->read_pos = pt->read_end = pt->read_buf;
pt->write_buf_size = iomem->write_buf_size;
- pt->write_buf = xmalloc (pt->write_buf_size);
+ if (buffered)
+ {
+ pt->read_buf = xmalloc (pt->read_buf_size);
+ pt->write_buf = xmalloc (pt->write_buf_size);
+ }
+ else
+ {
+ pt->read_buf = &pt->shortbuf;
+ pt->write_buf = &pt->shortbuf;
+ }
+ pt->read_pos = pt->read_end = pt->read_buf;
pt->write_pos = pt->write_buf;
pt->write_end = pt->write_buf + pt->write_buf_size;
@@ -973,7 +1027,9 @@ ioscm_init_memory_port (SCM port, CORE_ADDR start, CORE_ADDR end)
}
/* Re-initialize a memory port, updating its read/write buffer sizes.
- An exception is thrown if data is still buffered, except in the case
+ An exception is thrown if the port is unbuffered.
+ TODO: Allow switching buffered/unbuffered.
+ An exception is also thrown if data is still buffered, except in the case
where the buffer size isn't changing (since that's just a nop). */
static void
@@ -988,7 +1044,16 @@ ioscm_reinit_memory_port (SCM port, size_t read_buf_size,
gdb_assert (write_buf_size >= min_memory_port_buf_size
&& write_buf_size <= max_memory_port_buf_size);
- /* First check if anything is buffered. */
+ /* First check if the port is unbuffered. */
+
+ if (pt->read_buf == &pt->shortbuf)
+ {
+ gdb_assert (pt->write_buf == &pt->shortbuf);
+ scm_misc_error (func_name, _("port is unbuffered: ~a"),
+ scm_list_1 (port));
+ }
+
+ /* Next check if anything is buffered. */
if (read_buf_size != pt->read_buf_size
&& pt->read_end != pt->read_buf)
@@ -1029,17 +1094,16 @@ ioscm_reinit_memory_port (SCM port, size_t read_buf_size,
/* (open-memory [#:mode string] [#:start address] [#:size integer]) -> port
Return a port that can be used for reading and writing memory.
MODE is a string, and must be one of "r", "w", or "r+".
- For compatibility "b" (binary) may also be present, but we ignore it:
+ "0" may be appended to MODE to mark the port as unbuffered.
+ For compatibility "b" (binary) may also be appended, but we ignore it:
memory ports are binary only.
- TODO: Support "0" (unbuffered)? Only support "0" (always unbuffered)?
-
The chunk of memory that can be accessed can be bounded.
- If both START,SIZE are unspecified, all of memory can be accessed.
- If only START is specified, all of memory from that point on can be
- accessed. If only SIZE if specified, all memory in [0,SIZE) can be
- accessed. If both are specified, all memory in [START,START+SIZE) can be
- accessed.
+ If both START,SIZE are unspecified, all of memory can be accessed
+ (except 0xff..ff). If only START is specified, all of memory from that
+ point on can be accessed (except 0xff..ff). If only SIZE if specified,
+ all memory in [0,SIZE) can be accessed. If both are specified, all memory
+ in [START,START+SIZE) can be accessed.
Note: If it becomes useful enough we can later add #:end as an alternative
to #:size. For now it is left out.
@@ -1047,7 +1111,7 @@ ioscm_reinit_memory_port (SCM port, size_t read_buf_size,
The result is a Scheme port, and its semantics are a bit odd for accessing
memory (e.g., unget), but we don't try to hide this. It's a port.
- N.B. Seeks on the port must be in the range [0,size).
+ N.B. Seeks on the port must be in the range [0,size].
This is for similarity with bytevector ports, and so that one can seek
to the first byte. */
@@ -1076,19 +1140,8 @@ gdbscm_open_memory (SCM rest)
mode = xstrdup ("r");
scm_dynwind_free (mode);
- if (start == ~(CORE_ADDR) 0)
- {
- gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, scm_from_int (-1),
- _("start address of 0xff..ff not allowed"));
- }
-
if (size_arg_pos > 0)
{
- if (size == 0)
- {
- gdbscm_out_of_range_error (FUNC_NAME, 0, scm_from_int (0),
- "zero size");
- }
/* For now be strict about start+size overflowing. If it becomes
a nuisance we can relax things later. */
if (start + size < start)
@@ -1098,17 +1151,10 @@ gdbscm_open_memory (SCM rest)
gdbscm_scm_from_ulongest (size)),
_("start+size overflows"));
}
- end = start + size - 1;
- if (end == ~(CORE_ADDR) 0)
- {
- gdbscm_out_of_range_error (FUNC_NAME, 0,
- scm_list_2 (gdbscm_scm_from_ulongest (start),
- gdbscm_scm_from_ulongest (size)),
- _("end address of 0xff..ff not allowed"));
- }
+ end = start + size;
}
else
- end = (~(CORE_ADDR) 0) - 1;
+ end = ~(CORE_ADDR) 0;
mode_bits = ioscm_parse_mode_bits (FUNC_NAME, mode);
@@ -1168,7 +1214,8 @@ gdbscm_memory_port_read_buffer_size (SCM port)
}
/* (set-memory-port-read-buffer-size! port size) -> unspecified
- An exception is thrown if read data is still buffered. */
+ An exception is thrown if read data is still buffered or if the port
+ is unbuffered. */
static SCM
gdbscm_set_memory_port_read_buffer_size_x (SCM port, SCM size)
@@ -1209,7 +1256,8 @@ gdbscm_memory_port_write_buffer_size (SCM port)
}
/* (set-memory-port-write-buffer-size! port size) -> unspecified
- An exception is thrown if write data is still buffered. */
+ An exception is thrown if write data is still buffered or if the port
+ is unbuffered. */
static SCM
gdbscm_set_memory_port_write_buffer_size_x (SCM port, SCM size)
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index a61da5c..9b446af 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2015-05-16 Doug Evans <xdje42@gmail.com>
+
+ * gdb.guile/scm-ports.c: New file.
+ * gdb.guile/scm-ports.exp: Add memory port tests.
+
2015-05-16 Jan Kratochvil <jan.kratochvil@redhat.com>
* gdb.compile/compile-print.c: New file.
diff --git a/gdb/testsuite/gdb.guile/scm-ports.c b/gdb/testsuite/gdb.guile/scm-ports.c
new file mode 100644
index 0000000..b92fefb
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-ports.c
@@ -0,0 +1,22 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+ Copyright 2015 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/>. */
+
+int
+main (void)
+{
+ return 0;
+}
diff --git a/gdb/testsuite/gdb.guile/scm-ports.exp b/gdb/testsuite/gdb.guile/scm-ports.exp
index 099f5e6..420f183 100644
--- a/gdb/testsuite/gdb.guile/scm-ports.exp
+++ b/gdb/testsuite/gdb.guile/scm-ports.exp
@@ -18,20 +18,150 @@
load_lib gdb-guile.exp
-# Start with a fresh gdb.
-gdb_exit
-gdb_start
+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 }
+if ![gdb_guile_runto_main] {
+ return
+}
+
gdb_reinitialize_dir $srcdir/$subdir
gdb_install_guile_utils
gdb_install_guile_module
+gdb_scm_test_silent_cmd "guile (use-modules (rnrs io ports) (rnrs bytevectors))" \
+ "import (rnrs io ports) (rnrs bytevectors)"
+
gdb_test "guile (print (stdio-port? 42))" "= #f"
gdb_test "guile (print (stdio-port? (%make-void-port \"r\")))" "= #f"
gdb_test "guile (print (stdio-port? (input-port)))" "= #t"
gdb_test "guile (print (stdio-port? (output-port)))" "= #t"
gdb_test "guile (print (stdio-port? (error-port)))" "= #t"
+
+# Test memory port open/close.
+
+proc test_port { mode } {
+ with_test_prefix "basic $mode tests" {
+ gdb_test_no_output "guile (define my-port (open-memory #:mode \"$mode\"))" \
+ "create memory port"
+ gdb_test "guile (print (memory-port? my-port))" "= #t"
+ switch -glob $mode {
+ "r+*" {
+ gdb_test "guile (print (input-port? my-port))" "= #t"
+ gdb_test "guile (print (output-port? my-port))" "= #t"
+ }
+ "r*" {
+ gdb_test "guile (print (input-port? my-port))" "= #t"
+ gdb_test "guile (print (output-port? my-port))" "= #f"
+ }
+ "w*" {
+ gdb_test "guile (print (input-port? my-port))" "= #f"
+ gdb_test "guile (print (output-port? my-port))" "= #t"
+ }
+ default {
+ error "bad test mode"
+ }
+ }
+ gdb_test "guile (print (port-closed? my-port))" "= #f" \
+ "test port-closed? before it's closed"
+ gdb_test "guile (print (close-port my-port))" "= #t"
+ gdb_test "guile (print (port-closed? my-port))" "= #t" \
+ "test port-closed? after it's closed"
+ }
+}
+
+set port_variations { r w r+ rb wb r+b r0 w0 r+0 }
+foreach variation $port_variations {
+ test_port $variation
+}
+
+# Test read/write of memory ports.
+
+proc test_mem_port_rw { kind } {
+ if { "$kind" == "buffered" } {
+ set buffered 1
+ } else {
+ set buffered 0
+ }
+ with_test_prefix $kind {
+ if $buffered {
+ set mode "r+"
+ } else {
+ set mode "r+0"
+ }
+ gdb_test_no_output "guile (define rw-mem-port (open-memory #:mode \"$mode\"))" \
+ "create r/w memory port"
+ gdb_test "guile (print rw-mem-port)" \
+ "#<input-output: gdb:memory-port 0x0-0xf+>"
+ gdb_test_no_output "guile (define sp-reg (parse-and-eval \"\$sp\"))" \
+ "get sp reg"
+ # Note: Only use $sp_reg for gdb_test result matching, don't use it in
+ # gdb commands. Otherwise transcript.N becomes unusable.
+ set sp_reg [get_integer_valueof "\$sp" 0]
+ gdb_test_no_output "guile (define byte-at-sp (parse-and-eval \"*(char*) \$sp\"))" \
+ "save current value at sp"
+ # Pass the result of parse-and-eval through value-fetch-lazy!,
+ # otherwise the value gets left as a lazy reference to memory, which
+ # when re-evaluated after we flush the write will yield the newly
+ # written value. PR 18175
+ gdb_test_no_output "guile (value-fetch-lazy! byte-at-sp)" \
+ "un-lazyify byte-at-sp"
+ gdb_test "guile (print (seek rw-mem-port (value->integer sp-reg) SEEK_SET))" \
+ "= $sp_reg" \
+ "seek to \$sp"
+ gdb_test_no_output "guile (define old-value (value->integer byte-at-sp))" \
+ "define old-value"
+ gdb_test_no_output "guile (define new-value (logxor old-value 1))" \
+ "define new-value"
+ gdb_test "guile (print (put-bytevector rw-mem-port (make-bytevector 1 new-value)))" \
+ "= #<unspecified>"
+ if $buffered {
+ # Value shouldn't be in memory yet.
+ gdb_test "guile (print (value=? (parse-and-eval \"*(char*) \$sp\") byte-at-sp))" \
+ "= #t" \
+ "test byte at sp, before flush"
+ gdb_test_no_output "guile (force-output rw-mem-port)" \
+ "flush port"
+ }
+ # Value should be in memory now.
+ gdb_test "guile (print (value=? (parse-and-eval \"*(char*) \$sp\") byte-at-sp))" \
+ "= #f" \
+ "test byte at sp, after flush"
+ # Restore the value for cleanliness sake, and to verify close-port
+ # flushes the buffer.
+ gdb_test "guile (print (seek rw-mem-port (value->integer sp-reg) SEEK_SET))" \
+ "= $sp_reg" \
+ "seek to \$sp for restore"
+ gdb_test "guile (print (put-bytevector rw-mem-port (make-bytevector 1 old-value)))" \
+ "= #<unspecified>"
+ gdb_test "guile (print (close-port rw-mem-port))" \
+ "= #t"
+ gdb_test "guile (print (value=? (parse-and-eval \"*(char*) \$sp\") byte-at-sp))" \
+ "= #t" \
+ "test byte at sp, after close"
+ }
+}
+
+test_mem_port_rw buffered
+test_mem_port_rw unbuffered
+
+# Test zero-length memory ports.
+
+gdb_test_no_output "guile (define zero-mem-port (open-memory #:start 0 #:size 0 #:mode \"r+\"))" \
+ "create zero length memory port"
+gdb_test "guile (print (read-char zero-mem-port))" \
+ "= #<eof>"
+gdb_test "guile (print (write-char #\\a zero-mem-port))" \
+ "ERROR: .*Out of range: writing beyond end of memory range.*Error while executing Scheme code."
+gdb_test "guile (print (get-bytevector-n zero-mem-port 0))" \
+ "= #vu8\\(\\)"
+gdb_test "guile (print (put-bytevector zero-mem-port (make-bytevector 0)))" \
+ "= #<unspecified>"
+gdb_test "guile (print (close-port zero-mem-port))" "= #t"