From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from smtp.polymtl.ca (smtp.polymtl.ca [132.207.4.11]) by sourceware.org (Postfix) with ESMTPS id D00AB385696E for ; Mon, 11 Sep 2023 02:13:35 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org D00AB385696E Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=polymtl.ca Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=polymtl.ca Received: from simark.ca (simark.ca [158.69.221.121]) (authenticated bits=0) by smtp.polymtl.ca (8.14.7/8.14.7) with ESMTP id 38B2DUtK009184 (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES256-GCM-SHA384 bits=256 verify=NOT); Sun, 10 Sep 2023 22:13:34 -0400 DKIM-Filter: OpenDKIM Filter v2.11.0 smtp.polymtl.ca 38B2DUtK009184 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=polymtl.ca; s=default; t=1694398415; bh=Yp+pB/p6Lzn0qpLHCqlyivAHLGHF78CJRYyZhbRV5Dc=; h=From:To:Cc:Subject:Date:From; b=dcMHeSUW/Rssqu7/FhLK7ReJyAxvlKXA7jAqyPGMICZKh66mkKWRMmrkjCK5+EfAz BjY/+YaMHjuwudCSmd9EdCfxlpyYBNGzAsgi9+LOsqK0EZ+KRIR5RKXq4bU1JCBzlp +JIsfQkAglurEWrTTl+Y8OIyf0fgvOX+7m81sWpE= Received: from simark.localdomain (modemcable238.237-201-24.mc.videotron.ca [24.201.237.238]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by simark.ca (Postfix) with ESMTPSA id 250141E092; Sun, 10 Sep 2023 22:13:30 -0400 (EDT) From: Simon Marchi To: gdb-patches@sourceware.org Cc: Simon Marchi Subject: [PATCH] gdb/testsuite: use foreach_with_prefix in gdb.guile/scm-ports.exp Date: Sun, 10 Sep 2023 22:13:26 -0400 Message-ID: <20230911021329.1059595-1-simon.marchi@polymtl.ca> X-Mailer: git-send-email 2.42.0 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Poly-FromMTA: (simark.ca [158.69.221.121]) at Mon, 11 Sep 2023 02:13:30 +0000 X-Spam-Status: No, score=-3189.0 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,GIT_PATCH_0,RCVD_IN_DNSWL_LOW,RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,SPF_PASS,TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: Simplify things a bit using foreach_with_prefix. The only expected change is in the naming of tests. Change-Id: Icb5e55207e0209e0d44d9e7c16a2f5e11aa29017 --- 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 f0af5d4bbad2..7422a37345e5 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. base-commit: ebc76ef6e6017b3548207c45abf33ab6e8f9402d -- 2.42.0