Hi Guilers!
It looks like there was a subtle but significant regression introduced
to the behavior of `bitwise-copy-bit' in `(rnrs arithmetic bitwise)'
back in 93da406f33.
R6RS says [0] that function (with arguments EI1, EI2, EI3) should
transfer the EI2th bit from EI3 to EI1, but Guile's implementation was
always reading the 0th bit from EI3. This patch brings the
implementation back in line with the standard.
`fxcopy-bit' in `(rnrs artihmetic fixnum)' gets touched as well, since
it was relying on `bitwise-copy-bit'. Its behavior per R6RS is a
little different [1] in that its third argument _is_ the bit to be
set, so it's just easier to use SRFI-60's `copy-bit' to take its
value.
Any questions? Let me know.
Regards,
Julian
[0] - http://www.r6rs.org/final/html/r6rs-lib/r6rs-lib-Z-H-12.html#node_sec_11.4
[1] - http://www.r6rs.org/final/html/r6rs-lib/r6rs-lib-Z-H-12.html#node_sec_11.2
From 7a207740ffc344c7cd70411bba6c16beaea10818 Mon Sep 17 00:00:00 2001
From: Julian Graham <jool...@undecidable.net>
Date: Sat, 16 Sep 2017 20:09:32 -0400
Subject: [PATCH] Bring `bitwise-copy-bit' behavior back in line with R6RS.
A regression in 93da406f33 had this function copying the lowest ("0th") bit
from its "source" argument, whereas per R6RS it should be copying the same
bit from the source as it is setting in the "destination" argument.
* module/rnrs/arithmetic/bitwise.scm (bitwise-copy-bit): Read the EI2th bit
from EI3.
* module/rnrs/arithmetic/fixnums.scm (fxcopy-bit): Use `copy-bit' to read
the 0th bit from FX3.
* test-suite/test/r6rs-arithmetic-bitwise.test (bitwise-copy-bit): Update
expected value in test case.
---
module/rnrs/arithmetic/bitwise.scm | 4 ++--
module/rnrs/arithmetic/fixnums.scm | 7 ++++---
test-suite/tests/r6rs-arithmetic-bitwise.test | 2 +-
3 files changed, 7 insertions(+), 6 deletions(-)
diff --git a/module/rnrs/arithmetic/bitwise.scm b/module/rnrs/arithmetic/bitwise.scm
index 5f66cf1c1..a8ed2bc69 100644
--- a/module/rnrs/arithmetic/bitwise.scm
+++ b/module/rnrs/arithmetic/bitwise.scm
@@ -1,6 +1,6 @@
;;; bitwise.scm --- The R6RS bitwise arithmetic operations library
-;; Copyright (C) 2010, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2013, 2017 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -79,7 +79,7 @@
;; However, other values have been tolerated by both Guile 2.0.x and
;; the sample implementation given the R6RS library document, so for
;; backward compatibility we continue to permit it.
- (copy-bit ei2 ei1 (logbit? 0 ei3)))
+ (copy-bit ei2 ei1 (logbit? ei2 ei3)))
(define (bitwise-copy-bit-field ei1 ei2 ei3 ei4)
(copy-bit-field ei1 ei4 ei2 ei3))
diff --git a/module/rnrs/arithmetic/fixnums.scm b/module/rnrs/arithmetic/fixnums.scm
index 4ec1cae0c..6daee0e39 100644
--- a/module/rnrs/arithmetic/fixnums.scm
+++ b/module/rnrs/arithmetic/fixnums.scm
@@ -1,6 +1,6 @@
;;; fixnums.scm --- The R6RS fixnums arithmetic library
-;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011, 2013, 2017 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -93,7 +93,8 @@
(rnrs arithmetic bitwise (6))
(rnrs conditions (6))
(rnrs exceptions (6))
- (rnrs lists (6)))
+ (rnrs lists (6))
+ (only (srfi srfi-60) copy-bit))
(define fixnum-width
(let ((w (do ((i 0 (+ 1 i))
@@ -244,7 +245,7 @@
(assert-fixnum fx1 fx2 fx3)
(unless (and (<= 0 fx2) (< fx2 (fixnum-width)))
(raise (make-assertion-violation)))
- (bitwise-copy-bit fx1 fx2 fx3))
+ (copy-bit fx2 fx1 (logbit? 0 fx3)))
(define (fxbit-field fx1 fx2 fx3)
(assert-fixnum fx1 fx2 fx3)
diff --git a/test-suite/tests/r6rs-arithmetic-bitwise.test b/test-suite/tests/r6rs-arithmetic-bitwise.test
index 3e23d81f0..0492efd31 100644
--- a/test-suite/tests/r6rs-arithmetic-bitwise.test
+++ b/test-suite/tests/r6rs-arithmetic-bitwise.test
@@ -62,7 +62,7 @@
(with-test-prefix "bitwise-copy-bit"
(pass-if "bitwise-copy-bit simple"
- (eqv? (bitwise-copy-bit #b010 2 1) #b110)))
+ (eqv? (bitwise-copy-bit #b010 2 4) #b110)))
(with-test-prefix "bitwise-bit-field"
(pass-if "bitwise-bit-field simple"
--
2.11.0
