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.
This commit is contained in:
Doug Evans
parent
d976bace1c
commit
37442ce10a
|
|
@ -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
|
||||
|
|
|
|||
4
gdb/NEWS
4
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",
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
iomem->current += size;
|
||||
/* 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;
|
||||
|
||||
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)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
@ -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"
|
||||
|
|
|
|||
Loading…
Reference in New Issue