scheme-gnunet/tests/bv-slice.scm

;; This file is part of scheme-GNUnet.
;; Copyright (C) 2021, 2022 GNUnet e.V.
;;
;; scheme-GNUnet is free software: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; scheme-GNUnet 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
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;
;; SPDX-License-Identifier: AGPL-3.0-or-later

(import (gnu gnunet utils bv-slice)
	(srfi srfi-26)
	(ice-9 match)
	(only (rnrs base) assert)
	(rnrs conditions)
	(rnrs control)
	(rnrs exceptions)
	(rnrs bytevectors))

(test-begin "bv-slice")


;; slice-copy!

(define-syntax-rule (test-missing-caps test-case what permitted required code)
  (test-equal test-case
    (list what permitted required)
    (guard (c ((missing-capabilities? c)
	       (list (missing-capabilities-what c)
		     (missing-capabilities-permitted c)
		     (missing-capabilities-required c))))
      code)))

(test-missing-caps
 "destination of slice-copy! must be writable"
 'to
 CAP_READ
 CAP_WRITE
 (slice-copy! (make-slice/read-write 9)
	      (slice/read-only (make-slice/read-write 9))))

(test-missing-caps
 "source of slice-copy! must be readable"
 'from
 CAP_WRITE
 CAP_READ
 (slice-copy! (slice/write-only (make-slice/read-write 9))
	      (make-slice/read-write 9)))

(test-error "lengths must match (1)"
  &assertion
  (slice-copy! (make-slice/read-write 9)
	       (make-slice/read-write 0)))

(test-error "lengths must match (2)"
  &assertion
  (slice-copy! (make-slice/read-write 0)
	       (make-slice/read-write 9)))

(test-equal "slice-copy! copies"
  #vu8(0 1 2 3)
  (let ((source (bv-slice/read-write #vu8(0 1 2 3)))
	(dest   (make-slice/read-write 4)))
    (slice-copy! source dest)
    (slice-bv dest)))

(test-equal "also if there's an offset in the source"
  #vu8(0 1 2 3)
  (let ((source (slice-slice (bv-slice/read-write #vu8(0 0 1 2 3)) 1))
	(dest   (make-slice/read-write 4)))
    (slice-copy! source dest)
    (slice-bv dest)))

(test-equal "also if the destination bv is long"
  #vu8(9 8 0 1 2 3)
  (let ((source (bv-slice/read-write #vu8(8 0 1 2)))
	(dest (slice-slice
	       (bv-slice/read-write (bytevector-copy #vu8(9 7 7 7 7 3)))
	       1 4)))
    (slice-copy! source dest)
    (slice-bv dest)))



(test-equal "slice-zero! writes zeros"
  #vu8(1 2 0 0 5 6 7 8)
  (let ((dest
	 (slice-slice
	  (bv-slice/read-write (bytevector-copy #vu8(1 2 3 4 5 6 7 8)))
	  2 2)))
    (slice-zero! dest)
    (slice-bv dest)))

(test-missing-caps
 "slice-zero! requires writability"
 'slice
 CAP_READ
 CAP_WRITE
 (slice-zero! (slice/read-only (make-slice/read-write 9))))

(test-missing-caps
 "even if the length is zero"
 'slice
 CAP_READ
 CAP_WRITE
 (slice-zero! (slice/read-only (make-slice/read-write 0))))

(define (some-numbers N)
  (map (cut expt 2 <>) (iota N)))
(define sizes/u `(#(16 ,slice-u16-ref ,slice-u16-set!)
		  #(32 ,slice-u32-ref ,slice-u32-set!)
		  #(64 ,slice-u64-ref ,slice-u64-set!)))
(define sizes/s `(#(16 ,slice-s16-ref ,slice-s16-set!)
		  #(32 ,slice-s32-ref ,slice-s32-set!)
		  #(64 ,slice-s64-ref ,slice-s64-set!)))

(for-each
 (match-lambda
   (#(bits ref set!)
    (test-equal
	(string-append "slice-u" (number->string bits) "-ref/set! round-trips")
      (some-numbers bits)
      (map (lambda (number)
	     ;; #xde: filler that should be unused
	     (define bv (make-bytevector (/ bits 8) #xde))
	     (define sl (bv-slice/read-write bv))
	     (set! sl 0 number (endianness little))
	     (ref sl 0 (endianness little)))
	   (some-numbers bits)))))
 sizes/u)

(for-each
 (match-lambda
   (#(bits ref set!)
    (test-equal
	(string-append "slice-s" (number->string bits) "-ref/set! round-trips")
      (append (map - (some-numbers bits))
	      ;; -1: avoid the sign bit
	      (some-numbers (- bits 1)))
      (map (lambda (number)
	     ;; #xde: filler that should be unused
	     (define bv (make-bytevector (/ bits 8) #xde))
	     (define sl (bv-slice/read-write bv))
	     (set! sl 0 number (endianness little))
	     (ref sl 0 (endianness little)))
	   (append (map - (some-numbers bits))
		   (some-numbers (- bits 1)))))))
 sizes/s)

;; Signed integer representations are used in some network messages,
;; so make sure they will be interpreted the same no matter the
;; architecture.
(test-equal "two's complement is used"
  -128
  (slice-s8-ref (bv-slice/read-write #vu8(#b10000000)) 0))

(test-equal "slice to string, read-write"
  "#<slice (CAP_READ | CAP_WRITE): 1 2 3>"
  (object->string (bv-slice/read-write #vu8(1 2 3))))

(test-equal "slice to string, read-only"
  "#<slice (CAP_READ): 1 2 3>"
  (object->string
   (slice/read-only (bv-slice/read-write #vu8(1 2 3)))))

;; Make sure the lack of a read capability cannot be circumvented by
;; object->string.
(test-equal "slice to string, write-only"
  "#<slice (CAP_WRITE) length: 3>"
  (object->string
   (slice/write-only (bv-slice/read-write #vu8(1 2 3)))))

(test-missing-caps
 "source of slice-copy/read-write must be readable"
 'original
 CAP_WRITE
 CAP_READ
 (slice-copy/read-write (slice/write-only (make-slice/read-write 9))))

(test-missing-caps
 "even if the length is zero"
 'original
 CAP_WRITE
 CAP_READ
 (slice-copy/read-write (slice/write-only (make-slice/read-write 0))))

(test-assert "return value of slice-copy/read-write is read-write"
  (let ((copy (slice-copy/read-write (make-slice/read-write 9))))
    (and (slice-readable? copy) (slice-writable? copy))))
(test-assert "return value of slice-copy/read-write is read-write, even if length is zero"
  (let ((copy (slice-copy/read-write (make-slice/read-write 0))))
    (and (slice-readable? copy) (slice-writable? copy))))

(test-assert "return value of slice-copy/read-write independent of original"
  (let* ((original (make-slice/read-write 9))
	 (copy (slice-copy/read-write original)))
    (slice-independent? original copy)))
(test-assert "return value of slice-copy/read-write is fresh even if length is zero"
  (let* ((original (make-slice/read-write 0))
	 (copy (slice-copy/read-write original)))
    (not (eq? original copy))))
(test-equal "slice-copy/read-write returns something with the same contents (1)"
  #vu8(10 9 8 7 6 5)
  (let* ((original (bv-slice/read-write #vu8(11 10 9 8 7 6 5 4) 1 6))
	 (copy (slice-copy/read-write original))
	 (bv (make-bytevector 6)))
    (slice-copy! copy (bv-slice/read-write bv))
    bv))
(test-equal "slice-copy/read-write returns something with the same contents (2)"
  #vu8(10 9 8 7 6 5)
  (let* ((original (slice/read-only
		    (bv-slice/read-write #vu8(11 10 9 8 7 6 5 4) 1 6)))
	 (copy (slice-copy/read-write original))
	 (bv (make-bytevector 6)))
    (slice-copy! copy (bv-slice/read-write bv))
    bv))

(test-missing-caps
 "source of slice-copy/read-only must be readable"
 'original
 CAP_WRITE
 CAP_READ
 (slice-copy/read-only (slice/write-only (make-slice/read-write 9))))

(test-missing-caps
 "even if the size is zero"
 'original
 CAP_WRITE
 CAP_READ
 (slice-copy/read-only (slice/write-only (make-slice/read-write 0))))

(test-assert "return value of slice-copy/read-only is read-only"
  (let ((copy (slice-copy/read-only (make-slice/read-write 9))))
    (and (slice-readable? copy) (not (slice-writable? copy)))))
(test-assert "return value of slice-copy/read-only is read-only, even if length is zero"
  (let ((copy (slice-copy/read-only (make-slice/read-write 0))))
    (and (slice-readable? copy) (not (slice-writable? copy)))))
(test-assert "return value of slice-copy/read-only independent of original"
  (let* ((original (make-slice/read-write 9))
	 (copy (slice-copy/read-only original)))
    (slice-independent? original copy)))
(test-assert "return value of slice-copy/read-only is fresh even if length is zero (1)"
  (let* ((original (make-slice/read-write 0))
	 (copy (slice-copy/read-only original)))
    (not (eq? original copy))))
(test-assert "return value of slice-copy/read-only is fresh even if length is zero (2)"
  (let* ((original (slice/read-only (make-slice/read-write 0)))
	 (copy (slice-copy/read-only original)))
    (not (eq? original copy))))
(test-equal "slice-copy/read-only returns something with the same contents (1)"
  #vu8(10 9 8 7 6 5)
  (let* ((original (bv-slice/read-write #vu8(11 10 9 8 7 6 5 4) 1 6))
	 (copy (slice-copy/read-only original))
	 (bv (make-bytevector 6)))
    (slice-copy! copy (bv-slice/read-write bv))
    bv))
(test-equal "slice-copy/read-only returns something with the same contents (2)"
  #vu8(10 9 8 7 6 5)
  (let* ((original (slice/read-only
		    (bv-slice/read-write #vu8(11 10 9 8 7 6 5 4) 1 6)))
	 (copy (slice-copy/read-only original))
	 (bv (make-bytevector 6)))
    (slice-copy! copy (bv-slice/read-write bv))
    bv))

(test-assert "empty slices are independent"
  (slice-independent? (make-slice/read-write 0) (make-slice/read-write 0)))

(test-assert "empty slices are independent, even if using the same bytevector"
  (let ((bv #vu8()))
    (slice-independent? (bv-slice/read-write bv) (bv-slice/read-write bv))))

(test-assert "empty slices are independent, even when using offsets (1)"
  (let ((bv #vu8(0 1 2 3)))
    (slice-independent? (bv-slice/read-write bv 1 0)
			(bv-slice/read-write bv 2 0))))

(test-assert "empty slices are independent, even when using offsets (2)"
  (let ((bv #vu8(0 1 2 3)))
    (slice-independent? (bv-slice/read-write bv 2 0)
			(bv-slice/read-write bv 1 0))))

(test-assert "empty slices are independent, even if eq?"
  (let ((s (bv-slice/read-write #vu8())))
    (slice-independent? s s)))

(test-assert "slice-independent? is irreflexive (assuming non-empty) and ignores capabilities (1)"
  (let ((s (make-slice/read-write 99)))
    (not (slice-independent? (slice/write-only s) (slice/read-only s)))))

(test-assert "slice-independent? is irreflexive (assuming non-empty) and ignores capabilities (2)"
  (let ((s (make-slice/read-write 1)))
    (not (slice-independent? (slice/write-only s) (slice/read-only s)))))

(test-assert "empty slice is independent, even if inside the other slice"
  (let ((bv #vu8(0 1 2 3 4 5 6 7 8 9)))
    (do ((offset-x 0 (+ 1 offset-x)))
	((> offset-x (bytevector-length bv)) #true)
      (do ((length-x 0 (+ 1 length-x)))
	  ((>= length-x (- (bytevector-length bv) offset-x)))
	(let ((x (bv-slice/read-write bv offset-x length-x)))
	  (do ((offset 0 (+ 1 offset)))
	      ((>= offset (bytevector-length bv)) (values))
	    (let ((y (bv-slice/read-write bv offset 0)))
	      (assert (slice-independent? x y))
	      (assert (slice-independent? y x)))))))))

(test-assert "non-overlapping ranges are independent"
  (let ((bv #vu8(0 1 2 3 4 5 6 7 8 9)))
    (do ((offset-x 0 (+ 1 offset-x)))
	((> offset-x (bytevector-length bv)) #true)
      (do ((length-x 0 (+ 1 length-x)))
	  ((>= length-x (- (bytevector-length bv) offset-x)))
	(let ((x (bv-slice/read-write bv offset-x length-x)))
	  ;; Make a slice on the left
	  (do ((offset-y 0 (+ 1 offset-y)))
	      ((> offset-y offset-x))
	    (do ((length-y 0 (+ 1 length-y)))
		((>= (+ length-y offset-y) offset-x))
	      (let ((y (bv-slice/read-write bv offset-y length-y)))
		(assert (slice-independent? x y))
		(assert (slice-independent? y x)))))
	  ;; And a slice on the right
	  (do ((offset-y (+ offset-x length-x) (+ 1 offset-y)))
	      ((> offset-y (bytevector-length bv)))
	    (do ((length-y 0 (+ 1 length-y)))
		((>= (+ length-y offset-y) (bytevector-length bv)))
	      (let ((y (bv-slice/read-write bv offset-y length-y)))
		(assert (slice-independent? x y))
		(assert (slice-independent? y x))))))))))

(test-assert "overlapping ranges are dependent"
  (let ((bv #vu8(0 1 2 3 4 5 6 7 8 9)))
    (do ((offset-x 0 (+ 1 offset-x)))
	;; - 1 to make sure 'x' is non-empty
	((> offset-x (- (bytevector-length bv) 1)) #true)
      (do ((length-x 1 (+ 1 length-x)))
	  ((>= length-x (- (bytevector-length bv) offset-x)))
	(let ((x (bv-slice/read-write bv offset-x length-x)))
	  ;; Choose a start coordinate inside x or left of x
	  (do ((offset-y 0 (+ 1 offset-y)))
	      ((>= offset-y (+ offset-x length-x) -1))
	    ;; Choose a (non-empty) length
	    (do ((length-y (if (< offset-y offset-x)
			       (- offset-x offset-y -1)
			       1)
			   (+ 1 length-y)))
		((>= (+ offset-y length-y) (bytevector-length bv)))
	      (let ((y (bv-slice/read-write bv offset-y length-y)))
		(assert (not (slice-independent? x y)))
		(assert (not (slice-independent? y x)))))))))
    #true))

(test-end "bv-slice")

;; ^ TODO: test other procedures