[gnunet-scheme] branch master updated: bv-slice: Create a condition type for capability mismatches.

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a commit to branch master
in repository gnunet-scheme.

The following commit(s) were added to refs/heads/master by this push:
     new 8bda28b  bv-slice: Create a condition type for capability mismatches.
8bda28b is described below

commit 8bda28b34b133ead95a1a733fedc8643543feea1
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Tue Jan 11 23:00:19 2022 +0100

    bv-slice: Create a condition type for capability mismatches.
    
    It is not truly necessary but it makes error messages in tests
    a little neater.
    
    * gnu/gnunet/utils/bv-slice.scm
      (&missing-capabilities): New condition.
      (verify-slice-cap): New procedure.
      (make-select-capabilities): Use new procedure.
      (slice-zero!, slice-copy!): Likewise.
    * tests/bv-slice.scm
      (test-missing-caps): New macro.
      ("destination of slice-copy! must be writable")
      ("source of slice-copy! must be readable"): Also check the
      exception.
---
 gnu/gnunet/utils/bv-slice.scm | 66 ++++++++++++++++++++++++++++++++++---------
 tests/bv-slice.scm            | 37 ++++++++++++++++--------
 2 files changed, 79 insertions(+), 24 deletions(-)

diff --git a/gnu/gnunet/utils/bv-slice.scm b/gnu/gnunet/utils/bv-slice.scm
index add0f1b..ab6071c 100644
--- a/gnu/gnunet/utils/bv-slice.scm
+++ b/gnu/gnunet/utils/bv-slice.scm
@@ -1,5 +1,5 @@
 ;;   This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
-;;   Copyright (C) 2020, 2021 GNUnet e.V.
+;;   Copyright (C) 2020, 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
@@ -56,11 +56,22 @@
          slice-ieee-double-set!
          ;; Large operations
          slice-copy!
-         slice-zero!)
+         slice-zero!
+
+         ;; Exceptions
+         &missing-capabilities
+         make-missing-capabilities
+         missing-capabilities?
+         missing-capabilities-what
+         missing-capabilities-permitted
+         missing-capabilities-required
+         CAP_READ CAP_WRITE)
   (import (rnrs arithmetic bitwise)
          (rnrs base)
          (rnrs bytevectors)
          (rnrs control)
+         (rnrs conditions)
+         (rnrs exceptions)
          (rnrs records syntactic)
          (srfi srfi-31)
          ;; only for printing records
@@ -69,6 +80,28 @@
          (only (srfi srfi-9 gnu)
                set-record-type-printer!))
   
+  ;; Exceptions
+  (define-condition-type &missing-capabilities &error
+    %make-missing-capabilities missing-capabilities?
+    ;; For disambiguation (source, target, from, to, ...)
+    (what missing-capabilities-what)
+    ;; Union of CAP_READ, CAP_WRITE, ...
+    (permitted missing-capabilities-permitted)
+    ;; Union of CAP_READ, CAP_WRITE, ...
+    (required  missing-capabilities-required))
+
+  (define (make-missing-capabilities what permitted required)
+    "Make a &missing-capabilities condition.  @var{what} is a symbolic
+name for the slice, @var{permitted} the capabilities of the slice and
+@var{required} the capabilities that were needed."
+    ;; TODO: should ~(required <= permitted) be enforced?
+    (assert (and (integer? permitted) (exact? permitted)
+                (<= 0 permitted) (< permitted CAP_ALL)
+                (integer? required) (exact? required)
+                (<= 0 required) (< required CAP_ALL)))
+    (%make-missing-capabilities what permitted required))
+
+  
   ;; Slicing
 
   (define-record-type (<slice> %make-slice slice?)
@@ -185,18 +218,25 @@ the bytevector in place."
       (= (bitwise-and (slice-capability-bits slice) required-cap-bits)
         required-cap-bits)))
 
+  (define (verify-slice-cap what slice required-cap-bits)
+    "Verify that @var{slice} has the capabilities @var{required-cap-bits}.
+If not, raise an appropriate @code{&missing-capabilities}."
+    (unless ((make-slice-cap-p required-cap-bits) slice)
+      (let ((permitted-cap-bits (slice-capability-bits slice)))
+       (raise (make-missing-capabilities what permitted-cap-bits
+                                         required-cap-bits)))))
+
   (define slice-readable? (make-slice-cap-p CAP_READ))
   (define slice-writable? (make-slice-cap-p CAP_WRITE))
 
   (define (make-select-capabilities desired-cap-bits)
-    (let ((ok? (make-slice-cap-p desired-cap-bits)))
-      (slice-as-well
-       (lambda (slice)
-        (assert (ok? slice))
-        (%make-slice (slice-bv slice)
-                     (slice-offset slice)
-                     (slice-length slice)
-                     desired-cap-bits)))))
+    (slice-as-well
+     (lambda (slice)
+       (verify-slice-cap 'slice slice desired-cap-bits)
+       (%make-slice (slice-bv slice)
+                   (slice-offset slice)
+                   (slice-length slice)
+                   desired-cap-bits))))
   (define slice/read-only
     (make-select-capabilities CAP_READ))
   (define slice/write-only
@@ -264,7 +304,7 @@ the bytevector in place."
 
   (define (slice-zero! slice)
     "Zero out the writable slice @var{slice}."
-    (assert (slice-writable? slice))
+    (verify-slice-cap 'slice slice CAP_WRITE)
     ;; TODO optimise this and/or optimise guile's compiler
     ;; w.r.t. bytevectors, structs and type inference.
     (let loop ((i 0))
@@ -276,8 +316,8 @@ the bytevector in place."
   (define (slice-copy! from to)
     "Copy the contents of the readable slice @var{from} to
 the writable slice @var{slice}.  The slices may overlap."
-    (assert (slice-readable? from))
-    (assert (slice-writable? to))
+    (verify-slice-cap 'from from CAP_READ)
+    (verify-slice-cap 'to to CAP_WRITE)
     (assert (= (slice-length from) (slice-length to)))
     (bytevector-copy! (slice-bv from) (slice-offset from)
                      (slice-bv to) (slice-offset to)
diff --git a/tests/bv-slice.scm b/tests/bv-slice.scm
index e110592..9ccf765 100644
--- a/tests/bv-slice.scm
+++ b/tests/bv-slice.scm
@@ -1,5 +1,5 @@
 ;; This file is part of scheme-GNUnet.
-;; Copyright (C) 2021 GNUnet e.V.
+;; 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
@@ -20,6 +20,7 @@
        (srfi srfi-26)
        (ice-9 match)
        (rnrs conditions)
+       (rnrs exceptions)
        (rnrs bytevectors))
 
 (test-begin "bv-slice")
@@ -27,16 +28,30 @@
 
 ;; slice-copy!
 
-;; TODO maybe more specific conditions
-(test-error "destination of slice-copy! must be writable"
-  &assertion
-  (slice-copy! (make-slice/read-write 9)
-              (slice/read-only (make-slice/read-write 9))))
-
-(test-error "source of slice-copy! must be readable"
-  &assertion
-  (slice-copy! (slice/write-only (make-slice/read-write 9))
-              (make-slice/read-write 9)))
+(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

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.