diff options
author | Maxime Devos <maximedevos@telenet.be> | 2023-01-10 14:47:59 +0100 |
---|---|---|
committer | Maxime Devos <maximedevos@telenet.be> | 2023-01-15 14:14:04 +0100 |
commit | 46ddc3b6864a56df67ea80f085f79babecd68cc5 (patch) | |
tree | c8c20113f9c39d48a365e5030d9298bbda08865d | |
parent | ceb8a222f6fda3303859547650ab4c74f13ecb42 (diff) | |
download | gnunet-scheme-46ddc3b6864a56df67ea80f085f79babecd68cc5.tar.gz gnunet-scheme-46ddc3b6864a56df67ea80f085f79babecd68cc5.zip |
bv-slice: Add procedure for comparing slices.
* doc/scheme-gnunet.tm: Update copyright line.
* doc/bytevector-slices.scm (slice-contents-equal?): Document new
procedure.
* NEWS: Mention new procedure.
* gnu/gnunet/utils/bv-slice.scm (slice-contents-equal?):
New procedure.
* tests/bv-slice.scm
("first argument of slice-contents-equal? must be readable"):
("second argument of slice-contents-equal? must be readable"):
("slice-contents-equal? is reflexive")
("slice-contents-equal? is reflexive (read-only)")
("slice-contents-equal? #true backed by same bytevector but different offset")
("slice-contents-equal? #false backed by same bytevector but different offset")
("slice-contents-equal? #false backed by same bytevector but different length")
("slice-contents-equal? #false, same offset and length")
("copies are slice-contents-equal?")
("copies are slice-contents-equal? (read-only)")
("copies are slice-contents-equal? (one offset)"): New tests.
(make-a-bv): Helper procedure for tests.
-rw-r--r-- | NEWS | 3 | ||||
-rw-r--r-- | doc/bytevector-slices.tm | 14 | ||||
-rw-r--r-- | doc/scheme-gnunet.tm | 2 | ||||
-rw-r--r-- | gnu/gnunet/utils/bv-slice.scm | 21 | ||||
-rw-r--r-- | tests/bv-slice.scm | 80 |
5 files changed, 116 insertions, 4 deletions
@@ -1,5 +1,5 @@ | |||
1 | # -*- mode: org; coding: utf-8 -*- | 1 | # -*- mode: org; coding: utf-8 -*- |
2 | # Copyright (C) 2021,2022 GNUnet e.V. | 2 | # Copyright (C) 2021--2023 GNUnet e.V. |
3 | # SPDX-License-Identifier: FSFAP | 3 | # SPDX-License-Identifier: FSFAP |
4 | # Copying and distribution of this file, with or without modification, | 4 | # Copying and distribution of this file, with or without modification, |
5 | # are permitted in any medium without royalty provided the copyright | 5 | # are permitted in any medium without royalty provided the copyright |
@@ -16,6 +16,7 @@ | |||
16 | read%, select% and 'set%', less tedious when the type and slice remains | 16 | read%, select% and 'set%', less tedious when the type and slice remains |
17 | the same. Also, by using the new macros, the code base should now be a | 17 | the same. Also, by using the new macros, the code base should now be a |
18 | bit more readible. | 18 | bit more readible. |
19 | - New 'slice-contents-equal?' procedure. | ||
19 | ** Bugfixes | 20 | ** Bugfixes |
20 | - A potential (but unverified) bug with automatic collection is fixed -- | 21 | - A potential (but unverified) bug with automatic collection is fixed -- |
21 | previously, if DHT garbage was found multiple times within a single | 22 | previously, if DHT garbage was found multiple times within a single |
diff --git a/doc/bytevector-slices.tm b/doc/bytevector-slices.tm index 5b1019f..3274ece 100644 --- a/doc/bytevector-slices.tm +++ b/doc/bytevector-slices.tm | |||
@@ -132,6 +132,20 @@ | |||
132 | </explain|Return <scm|#true> if the slice <var|slice> is writable, | 132 | </explain|Return <scm|#true> if the slice <var|slice> is writable, |
133 | <scm|#false> otherwise.> | 133 | <scm|#false> otherwise.> |
134 | 134 | ||
135 | <\explain> | ||
136 | <scm|(slice-contents-equal? <var|this> | ||
137 | <var|that>)><index|slice-contents-equal?> | ||
138 | <|explain> | ||
139 | Return <scm|#true> if the two readable bytevector slices <var|this> and | ||
140 | <var|that> have the same contents, i.e., they have the same length and | ||
141 | the same octet at each index. If one of the slices is not readable, a | ||
142 | <scm|&missing-capabilities> exception is raised, with the | ||
143 | \<#2018\>what\<#2019\> field set to the name of the argument as a symbol. | ||
144 | If both slices are not readable, it is unspecified whether | ||
145 | \<#2018\>what\<#2019\> is \<#2018\>this\<#2019\> or | ||
146 | \<#2018\>that\<#2019\>. | ||
147 | </explain> | ||
148 | |||
135 | <section|Reading / modifying bytevector slices> | 149 | <section|Reading / modifying bytevector slices> |
136 | 150 | ||
137 | To read the value at a (byte) index in the slice, the procedures | 151 | To read the value at a (byte) index in the slice, the procedures |
diff --git a/doc/scheme-gnunet.tm b/doc/scheme-gnunet.tm index 9816852..c791f65 100644 --- a/doc/scheme-gnunet.tm +++ b/doc/scheme-gnunet.tm | |||
@@ -7,7 +7,7 @@ | |||
7 | manual>|<doc-author|<author-data|<author-name|Maxime | 7 | manual>|<doc-author|<author-data|<author-name|Maxime |
8 | Devos>|<author-email|maximedevos@telenet.be>>>> | 8 | Devos>|<author-email|maximedevos@telenet.be>>>> |
9 | 9 | ||
10 | Copyright \<#A9\> 2012-2016, 2021, 2022 GNUnet e.V. | 10 | Copyright \<#A9\> 2012-2016, 2021\U2023 GNUnet e.V. |
11 | 11 | ||
12 | Permission is granted to copy, distribute and/or modify this document under | 12 | Permission is granted to copy, distribute and/or modify this document under |
13 | the terms of the GNU Free Documentation License, Version 1.3 or any later | 13 | the terms of the GNU Free Documentation License, Version 1.3 or any later |
diff --git a/gnu/gnunet/utils/bv-slice.scm b/gnu/gnunet/utils/bv-slice.scm index 72ab94d..edbcf41 100644 --- a/gnu/gnunet/utils/bv-slice.scm +++ b/gnu/gnunet/utils/bv-slice.scm | |||
@@ -1,6 +1,6 @@ | |||
1 | ;#!r6rs | 1 | ;#!r6rs |
2 | ;; This file is part of scheme-GNUnet, a partial Scheme port of GNUnet. | 2 | ;; This file is part of scheme-GNUnet, a partial Scheme port of GNUnet. |
3 | ;; Copyright (C) 2020, 2021, 2022 GNUnet e.V. | 3 | ;; Copyright (C) 2020--2023 GNUnet e.V. |
4 | ;; | 4 | ;; |
5 | ;; scheme-GNUnet is free software: you can redistribute it and/or modify it | 5 | ;; scheme-GNUnet is free software: you can redistribute it and/or modify it |
6 | ;; under the terms of the GNU Affero General Public License as published | 6 | ;; under the terms of the GNU Affero General Public License as published |
@@ -58,6 +58,7 @@ | |||
58 | slice-ieee-double-ref | 58 | slice-ieee-double-ref |
59 | slice-ieee-double-set! | 59 | slice-ieee-double-set! |
60 | ;; Large operations | 60 | ;; Large operations |
61 | slice-contents-equal? | ||
61 | slice-copy! | 62 | slice-copy! |
62 | slice-zero! | 63 | slice-zero! |
63 | slice-copy/bytevector | 64 | slice-copy/bytevector |
@@ -320,6 +321,24 @@ If not, raise an appropriate @code{&missing-capabilities}." | |||
320 | 321 | ||
321 | ;; ‘Large’ operations. | 322 | ;; ‘Large’ operations. |
322 | 323 | ||
324 | (define (slice-contents-equal? this that) | ||
325 | "Check if the readable bytevector slices @var{this} and @var{that} | ||
326 | have the same contents. I.e., the lengths are the same and for all | ||
327 | valid index, the octets at that index are equal. | ||
328 | |||
329 | The current implementation, as a side-effect, does allocations. | ||
330 | This is a bug." | ||
331 | (verify-slice-readable 'this this) | ||
332 | (verify-slice-readable 'that that) | ||
333 | ;; fast paths | ||
334 | (or (eq? this that) | ||
335 | (and (eq? (slice-bv this) (slice-bv that)) | ||
336 | (= (slice-offset this) (slice-offset that)) | ||
337 | (= (slice-length this) (slice-length that))) | ||
338 | ;; slow path (TODO: replace this with a 'memcmp' equivalent | ||
339 | ;; once Guile supports that). | ||
340 | (equal? (slice-copy/bytevector this) (slice-copy/bytevector that)))) | ||
341 | |||
323 | (define (slice-zero! slice) | 342 | (define (slice-zero! slice) |
324 | "Zero out the writable slice @var{slice}." | 343 | "Zero out the writable slice @var{slice}." |
325 | (verify-slice-writable 'slice slice) | 344 | (verify-slice-writable 'slice slice) |
diff --git a/tests/bv-slice.scm b/tests/bv-slice.scm index 043f6af..a48f7e3 100644 --- a/tests/bv-slice.scm +++ b/tests/bv-slice.scm | |||
@@ -1,5 +1,5 @@ | |||
1 | ;; This file is part of scheme-GNUnet. | 1 | ;; This file is part of scheme-GNUnet. |
2 | ;; Copyright (C) 2021, 2022 GNUnet e.V. | 2 | ;; Copyright (C) 2021--2023 GNUnet e.V. |
3 | ;; | 3 | ;; |
4 | ;; scheme-GNUnet is free software: you can redistribute it and/or modify it | 4 | ;; scheme-GNUnet is free software: you can redistribute it and/or modify it |
5 | ;; under the terms of the GNU Affero General Public License as published | 5 | ;; under the terms of the GNU Affero General Public License as published |
@@ -40,6 +40,84 @@ | |||
40 | code))) | 40 | code))) |
41 | 41 | ||
42 | (test-missing-caps | 42 | (test-missing-caps |
43 | "first argument of slice-contents-equal? must be readable" | ||
44 | 'this | ||
45 | CAP_WRITE | ||
46 | CAP_READ | ||
47 | (slice-contents-equal? (slice/write-only (make-slice/read-write 9)) | ||
48 | (make-slice/read-write 9))) | ||
49 | |||
50 | (test-missing-caps | ||
51 | "second argument of slice-contents-equal? must be readable" | ||
52 | 'that | ||
53 | CAP_WRITE | ||
54 | CAP_READ | ||
55 | (slice-contents-equal? (make-slice/read-write 9) | ||
56 | (slice/write-only (make-slice/read-write 9)))) | ||
57 | |||
58 | (define (make-a-bv n) | ||
59 | (define bv (make-bytevector n)) | ||
60 | (let loop ((i 0)) | ||
61 | (when (< 0 i n) | ||
62 | (bytevector-u8-set! bv i (random 256)))) | ||
63 | bv) | ||
64 | |||
65 | (test-assert "slice-contents-equal? is reflexive" | ||
66 | (let ((s (make-slice/read-write 10))) | ||
67 | (slice-contents-equal? s s))) | ||
68 | |||
69 | (test-assert "slice-contents-equal? is reflexive (read-only)" | ||
70 | (let ((s (slice/read-only (make-slice/read-write 10)))) | ||
71 | (slice-contents-equal? s s))) | ||
72 | |||
73 | (test-assert "slice-contents-equal? #true backed by same bytevector but different offset" | ||
74 | (let* ((s (bv-slice/read-only #vu8(0 1 2 3 | ||
75 | 0 1 2 3))) | ||
76 | (s1 (slice/read-only s 0 4)) | ||
77 | (s2 (slice/read-only s 4 4))) | ||
78 | (and (slice-contents-equal? s1 s2) | ||
79 | (slice-contents-equal? s2 s1)))) | ||
80 | |||
81 | (test-assert "slice-contents-equal? #false backed by same bytevector but different offset" | ||
82 | (let* ((bv (bv-slice/read-only #vu8(0 1 2 3 | ||
83 | 0 1 2 4))) | ||
84 | (s1 (slice/read-only bv 0 4)) | ||
85 | (s2 (slice/read-only bv 4 4))) | ||
86 | (and (not (slice-contents-equal? s1 s2)) | ||
87 | (not (slice-contents-equal? s2 s1))))) | ||
88 | |||
89 | (test-assert "slice-contents-equal? #false backed by same bytevector but different length" | ||
90 | (let* ((s (bv-slice/read-only #vu8(0 1 2 3 4))) | ||
91 | (s1 (slice/read-only s 0 4)) | ||
92 | (s2 (slice/read-only s 0 5))) | ||
93 | (and (not (slice-contents-equal? s1 s2)) | ||
94 | (not (slice-contents-equal? s2 s1))))) | ||
95 | |||
96 | (test-assert "slice-contents-equal? #false, same offset and length" | ||
97 | (let ((s1 (bv-slice/read-only #vu8(0 1 2 3))) | ||
98 | (s2 (bv-slice/read-only #vu8(10 11 12 13)))) | ||
99 | (and (not (slice-contents-equal? s1 s2)) | ||
100 | (not (slice-contents-equal? s2 s1))))) | ||
101 | |||
102 | (test-assert | ||
103 | "copies are slice-contents-equal?" | ||
104 | (let* ((bv (make-a-bv 10)) | ||
105 | (s (bv-slice/read-write bv))) | ||
106 | (slice-contents-equal? s (slice-copy/read-write s)))) | ||
107 | |||
108 | (test-assert | ||
109 | "copies are slice-contents-equal? (read-only)" | ||
110 | (let* ((bv (make-a-bv 10)) | ||
111 | (s (bv-slice/read-write bv))) | ||
112 | (slice-contents-equal? (slice/read-only s) (slice-copy/read-only s)))) | ||
113 | |||
114 | (test-assert | ||
115 | "copies are slice-contents-equal? (one offset)" | ||
116 | (let* ((bv (make-a-bv 10)) | ||
117 | (s (bv-slice/read-write bv 1))) | ||
118 | (slice-contents-equal? s (slice-copy/read-only s)))) | ||
119 | |||
120 | (test-missing-caps | ||
43 | "destination of slice-copy! must be writable" | 121 | "destination of slice-copy! must be writable" |
44 | 'to | 122 | 'to |
45 | CAP_READ | 123 | CAP_READ |