From 31131df04b7b14257a7e4acd3ed3d843c6f98bad Mon Sep 17 00:00:00 2001 From: Simon Marchi Date: Sun, 10 Sep 2023 22:13:26 -0400 Subject: [PATCH] gdb/testsuite: use foreach_with_prefix in gdb.guile/scm-ports.exp Simplify things a bit using foreach_with_prefix. The only expected change is in the naming of tests. Change-Id: Icb5e55207e0209e0d44d9e7c16a2f5e11aa29017 Approved-By: Andrew Burgess --- gdb/testsuite/gdb.guile/scm-ports.exp | 114 ++++++++++++-------------- 1 file changed, 54 insertions(+), 60 deletions(-) diff --git a/gdb/testsuite/gdb.guile/scm-ports.exp b/gdb/testsuite/gdb.guile/scm-ports.exp index f0af5d4bbad..7422a37345e 100644 --- a/gdb/testsuite/gdb.guile/scm-ports.exp +++ b/gdb/testsuite/gdb.guile/scm-ports.exp @@ -83,73 +83,67 @@ foreach variation $port_variations { # Test read/write of memory ports. -proc test_mem_port_rw { kind } { - if { "$kind" == "buffered" } { - set buffered 1 +proc test_mem_port_rw { buffered } { + if $buffered { + set mode "r+" } else { - set buffered 0 + set mode "r+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)" \ - "#" - 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_valueof /u "\$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)))" \ - "= #" - 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)))" \ - "= #" - gdb_test "guile (print (close-port rw-mem-port))" \ - "= #t" + 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)" \ + "#" + 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_valueof /u "\$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)))" \ + "= #" + 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, after close" + "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)))" \ + "= #" + 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 +foreach_with_prefix buffered {1 0} { + test_mem_port_rw $buffered +} # Test zero-length memory ports. -- 2.30.2