Add support for unbuffered and zero sized Guile ports.
authorDoug Evans <xdje42@gmail.com>
Sat, 16 May 2015 19:14:26 +0000 (12:14 -0700)
committerDoug Evans <xdje42@gmail.com>
Sat, 16 May 2015 19:14:26 +0000 (12:14 -0700)
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.

gdb/ChangeLog
gdb/NEWS
gdb/doc/ChangeLog
gdb/doc/guile.texi
gdb/guile/scm-ports.c
gdb/testsuite/ChangeLog
gdb/testsuite/gdb.guile/scm-ports.c [new file with mode: 0644]
gdb/testsuite/gdb.guile/scm-ports.exp

index 500eae17f7db5302d202e212b343d88d83afa4bd..73a423d2132ecf695cee90930830a2dd650671be 100644 (file)
@@ -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
index d27beaa4b8429f3577e1f26831f7e7fb4b4379dd..e08dd0da382fefa5fce4d4a1da4e1ebeaefd6867 100644 (file)
--- a/gdb/NEWS
+++ b/gdb/NEWS
 
 * 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",
index 10bb5793839df9ad54b639753bdee12435432123..f8b048714fff7860f9e30cd3654c8e817a60f5e4 100644 (file)
@@ -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.
index 04572fd9467fa3ad372deb8874ac0c36dd94b531..a0147c1873c4a978c6984aa511a51d1fde294cee 100644 (file)
@@ -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
index 8967b923a35124a56195db135f3b5d783c4a8a17..622507b4a575008183b13434dbfb46491a359c80 100644 (file)
@@ -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)
index a61da5cfc4fbadf89e03c5a9579f86195d695ade..9b446afb384373e9ed39471e16b1c6f24b522136 100644 (file)
@@ -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 (file)
index 0000000..b92fefb
--- /dev/null
@@ -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;
+}
index 099f5e66fb0eb0868047571740bbaaafc54034cc..420f183955a913ff173ecbf2af0d728ea6f91ea9 100644 (file)
 
 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"