[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] 08/16: Use r7rs-symbols, for compatibility with Racket.
|
From: |
gnunet |
|
Subject: |
[gnunet-scheme] 08/16: Use r7rs-symbols, for compatibility with Racket. |
|
Date: |
Mon, 05 Sep 2022 21:34:00 +0200 |
This is an automated email from the git hooks/post-receive script.
maxime-devos pushed a commit to branch master
in repository gnunet-scheme.
commit 1930e620893db7d4e0d6ab8e1782427878c73e3f
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sat Sep 3 21:51:08 2022 +0200
Use r7rs-symbols, for compatibility with Racket.
---
gnu/gnunet/cadet/client.scm | 16 ++--
gnu/gnunet/cadet/network.scm | 16 ++--
gnu/gnunet/concurrency/lost-and-found.scm | 2 +-
gnu/gnunet/concurrency/repeated-condition.scm | 2 +-
gnu/gnunet/config/expand.scm | 22 ++---
gnu/gnunet/config/fs.scm | 4 +-
gnu/gnunet/config/parser.scm | 92 ++++++++++----------
gnu/gnunet/dht/client.scm | 16 ++--
gnu/gnunet/dht/network.scm | 16 ++--
gnu/gnunet/mq.scm | 2 +-
tests/config-expand.scm | 28 +++---
tests/config-parser.scm | 120 +++++++++++++-------------
tests/lost-and-found.scm | 2 +-
tests/network-size.scm | 10 +--
tests/utils.scm | 16 ++--
15 files changed, 182 insertions(+), 182 deletions(-)
diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index 7a39857..bc1b8b8 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -29,19 +29,19 @@
;; Network manipulation procedures
;; (these belong to (gnu gnunet cadet network)).
(rename (analyse-local-channel-create
- #{ analyse-local-channel-create}#)
+ | analyse-local-channel-create|)
(construct-local-channel-create
- #{ construct-local-channel-create}#)
+ | construct-local-channel-create|)
(analyse-local-channel-destroy
- #{ analyse-local-channel-destroy}#)
+ | analyse-local-channel-destroy|)
(construct-local-channel-destroy
- #{ construct-local-channel-destroy}#)
- (analyse-local-data #{ analyse-local-data}#)
- (construct-local-data #{ construct-local-data}#)
+ | construct-local-channel-destroy|)
+ (analyse-local-data | analyse-local-data|)
+ (construct-local-data | construct-local-data|)
(analyse-local-acknowledgement
- #{ analyse-local-acknowledgement}#)
+ | analyse-local-acknowledgement|)
(construct-local-acknowledgement
- #{ construct-local-acknowledgement}#)))
+ | construct-local-acknowledgement|)))
(import (only (gnu extractor enum)
value->index symbol-value)
(only (gnu gnunet cadet struct)
diff --git a/gnu/gnunet/cadet/network.scm b/gnu/gnunet/cadet/network.scm
index 7c76009..dddeecf 100644
--- a/gnu/gnunet/cadet/network.scm
+++ b/gnu/gnunet/cadet/network.scm
@@ -22,17 +22,17 @@
construct-local-data analyse-local-data
construct-local-acknowledgement analyse-local-acknowledgement)
(import (rename (gnu gnunet cadet client)
- (#{ construct-local-channel-create}#
+ (| construct-local-channel-create|
construct-local-channel-create)
- (#{ analyse-local-channel-create}#
+ (| analyse-local-channel-create|
analyse-local-channel-create)
- (#{ construct-local-channel-destroy}#
+ (| construct-local-channel-destroy|
construct-local-channel-destroy)
- (#{ analyse-local-channel-destroy}#
+ (| analyse-local-channel-destroy|
analyse-local-channel-destroy)
- (#{ construct-local-data}# construct-local-data)
- (#{ analyse-local-data}# analyse-local-data)
- (#{ construct-local-acknowledgement}#
+ (| construct-local-data| construct-local-data)
+ (| analyse-local-data| analyse-local-data)
+ (| construct-local-acknowledgement|
construct-local-acknowledgement)
- (#{ analyse-local-acknowledgement}#
+ (| analyse-local-acknowledgement|
analyse-local-acknowledgement))))
diff --git a/gnu/gnunet/concurrency/lost-and-found.scm
b/gnu/gnunet/concurrency/lost-and-found.scm
index 0e09c87..711f3a6 100644
--- a/gnu/gnunet/concurrency/lost-and-found.scm
+++ b/gnu/gnunet/concurrency/lost-and-found.scm
@@ -22,7 +22,7 @@
(export make-lost-and-found lost-and-found? collect-lost-and-found-operation
make-losable <losable> losable? losable-lost-and-found
;; exported for tests
- (rename (add-found! #{ add-found!}#)))
+ (rename (add-found! | add-found!|)))
(import (only (rnrs base)
begin let define lambda quote if cond eq? assert cons list)
(only (rnrs control)
diff --git a/gnu/gnunet/concurrency/repeated-condition.scm
b/gnu/gnunet/concurrency/repeated-condition.scm
index 181e640..f0c0c8b 100644
--- a/gnu/gnunet/concurrency/repeated-condition.scm
+++ b/gnu/gnunet/concurrency/repeated-condition.scm
@@ -30,7 +30,7 @@
let^)
(prefix (only (fibers conditions)
make-condition signal-condition! wait-operation)
- #{cvar:}#)
+ |cvar:|)
(only (fibers operations)
choice-operation perform-operation)
(only (ice-9 atomic)
diff --git a/gnu/gnunet/config/expand.scm b/gnu/gnunet/config/expand.scm
index 7da87de..5a5fd0c 100644
--- a/gnu/gnunet/config/expand.scm
+++ b/gnu/gnunet/config/expand.scm
@@ -48,10 +48,10 @@
(only (gnu gnunet config parser)
literal-position? expo:literal-start expo:literal-end
$-position? expo:$-name-start expo:$-name-end
- #{${}-position?}# #{expo:${}-name-start}#
- #{expo:${}-name-end}# #{${:-}-position?}#
- #{expo:${:-}-name-start}# #{expo:${:-}-name-end}#
- #{expo:${:-}-value-parts}#)
+ |${}-position?| #{expo:${}-name-start}#
+ |expo:${}-name-end| #{${:-}-position?}#
+ |expo:${:-}-name-start| #{expo:${:-}-name-end}#
+ |expo:${:-}-value-parts|)
(only (gnu gnunet utils hat-let)
let^))
(begin
@@ -158,21 +158,21 @@ No restrictions are set on what constitutes a line."
(<-- (line expo-list)
(query-required line start end)))
(recurse/visit line expo-list start end)))
- (#{${}-position?}#
- (let^ ((! start (#{expo:${}-name-start}# expo))
- (! end (#{expo:${}-name-end}# expo))
+ (|${}-position?|
+ (let^ ((! start (|expo:${}-name-start| expo))
+ (! end (|expo:${}-name-end| expo))
(<-- (line expo-list)
(query-required line start end)))
(recurse/visit line expo-list start end)))
- (#{${:-}-position?}#
- (let^ ((! start (#{expo:${:-}-name-start}# expo))
- (! end (#{expo:${:-}-name-end}# expo)))
+ (|${:-}-position?|
+ (let^ ((! start (|expo:${:-}-name-start| expo))
+ (! end (|expo:${:-}-name-end| expo)))
(call-with-values
(lambda () (query line start end))
(case-lambda
;; If this variable is undefined, use the default.
(()
- (recurse line (#{expo:${:-}-value-parts}# expo) visited))
+ (recurse line (|expo:${:-}-value-parts| expo) visited))
((line expo-list)
(recurse/visit line expo-list start end)))))))))
(for-each expand expo-list)
diff --git a/gnu/gnunet/config/fs.scm b/gnu/gnunet/config/fs.scm
index 5c43802..e709c1f 100644
--- a/gnu/gnunet/config/fs.scm
+++ b/gnu/gnunet/config/fs.scm
@@ -139,7 +139,7 @@ where @var{value} is a list of expansible objects."
...))
(define-loops
(((no-section no-section*))
- (cond ((#{[]-position?}# object)
+ (cond ((|[]-position?| object)
(section*
(substring line
(position:section-name-start object)
@@ -154,7 +154,7 @@ where @var{value} is a list of expansible objects."
;; comments, empty line
(#t (no-section*))))
(((section section*) section-name)
- (cond ((#{[]-position?}# object)
+ (cond ((|[]-position?| object)
(section*
(substring line
(position:section-name-start object)
diff --git a/gnu/gnunet/config/parser.scm b/gnu/gnunet/config/parser.scm
index 30562fd..956e19e 100644
--- a/gnu/gnunet/config/parser.scm
+++ b/gnu/gnunet/config/parser.scm
@@ -26,12 +26,12 @@
(export parse-line ;; line parser
<position:%> make-%-position %-position?
position:%
- <position:#> make-#-position #{#-position?}#
+ <position:#> make-#-position |#-position?|
position:#
<position:=> make-=-position =-position?
position:variable-start position:variable-end
position:= position:value-start position:value-end
- #{<position:[]>}# #{make-[]-position}# #{[]-position?}#
+ |<position:[]>| #{make-[]-position}# #{[]-position?}#
position:section-name-start position:section-name-end
<position:@inline@> make-@inline@-position @inline@-position?
position:@inline@-start position:@inline@-end
@@ -40,15 +40,15 @@
;; expansion parser (data types)
<expo:literal> make-literal-position literal-position?
<expo:$> make-$-position $-position?
- #{<expo:${}>}# #{make-${}-position}# #{${}-position?}#
- #{<expo:${:-}>}# #{make-${:-}-position}# #{${:-}-position?}#
+ |<expo:${}>| #{make-${}-position}# #{${}-position?}#
+ |<expo:${:-}>| #{make-${:-}-position}# #{${:-}-position?}#
expo:literal-start expo:literal-end
expo:$-name-start expo:$-name-end
- #{expo:${}-name-start}# #{expo:${}-name-end}#
- #{expo:${:-}-name-start}# #{expo:${:-}-name-end}#
- #{expo:${:-}-value-start}# #{expo:${:-}-value-end}#
- #{expo:${:-}-value-parts}#
+ |expo:${}-name-start| #{expo:${}-name-end}#
+ |expo:${:-}-name-start| #{expo:${:-}-name-end}#
+ |expo:${:-}-value-start| #{expo:${:-}-value-end}#
+ |expo:${:-}-value-parts|
;; expansion parser (conditions)
&expansion-violation &empty-variable-violation &missing-close
@@ -129,8 +129,8 @@
"@var{%} is the position of the @code{#\\%} comment character in
a comment.")
- (define-positions-type (<position:#> make-#-position #{#-position?}#)
- ((#{#}# position:#))
+ (define-positions-type (<position:#> make-#-position |#-position?|)
+ ((|#| position:#))
()
"@var{#} is the position of the @code{#\\#} comment character in
a comment.")
@@ -153,7 +153,7 @@ If the value is empty, then by convention
@var{variable-start} and
@var{variable-end} are the positions right after the equality sign.")
(define-positions-type
- (#{<position:[]>}# #{make-[]-position}# #{[]-position?}#)
+ (|<position:[]>| #{make-[]-position}# #{[]-position?}#)
((section-name-start position:section-name-start)
(section-name-end position:section-name-end))
;; TODO: should empty section names be allowed?
@@ -217,7 +217,7 @@ of other types may be returned."
;; Is this a section name? Then stop.
(? (and (char=? #\[ first-important-character)
(char=? #\] (string-ref line end-inclusive)))
- (#{make-[]-position}# (+ 1 start-inclusive) end-inclusive))
+ (|make-[]-position| (+ 1 start-inclusive) end-inclusive))
;; Is this an inclusion directive? Then stop.
;; TODO upstream GNUnet compares case-insensitively.
;; Is this a bug or a feature?
@@ -269,29 +269,29 @@ the start and end positions of a region of texts without
expansions.")
"@var{$-name-start} (inclusive) and @var{$-name-end} (exclusive) are the
start and end positions of a variable name in an expansion X/$VAR/etcetera.")
- (define-positions-type (#{<expo:${}>}# #{make-${}-position}#
- #{${}-position?}#)
- ((#{${}-name-start}# #{expo:${}-name-start}#)
- (#{${}-name-end}# #{expo:${}-name-end}#))
- ((< #{${}-name-start}# #{${}-name-end}#))
+ (define-positions-type (|<expo:${}>| #{make-${}-position}#
+ |${}-position?|)
+ ((|${}-name-start| #{expo:${}-name-start}#)
+ (|${}-name-end| #{expo:${}-name-end}#))
+ ((< |${}-name-start| #{${}-name-end}#))
"@var{$@{@}-name-start} (inclusive) and @var{$@{@}-name-end}
(exclusive) are the start and end positions of a variable name in an expansion
${VAR}.")
- (define-record-type (#{<expo:${:-}>}# #{make-${:-}-position}#
- #{${:-}-position?}#)
- (fields (immutable #{${:-}-name-start}# #{expo:${:-}-name-start}#)
- (immutable #{${:-}-name-end}# #{expo:${:-}-name-end}#)
- (immutable #{${:-}-value-start}# #{expo:${:-}-value-start}#)
- (immutable #{${:-}-value-end}# #{expo:${:-}-value-end}#)
- (immutable #{${:-}-value-parts}# #{expo:${:-}-value-parts}#))
+ (define-record-type (|<expo:${:-}>| #{make-${:-}-position}#
+ |${:-}-position?|)
+ (fields (immutable |${:-}-name-start| #{expo:${:-}-name-start}#)
+ (immutable |${:-}-name-end| #{expo:${:-}-name-end}#)
+ (immutable |${:-}-value-start| #{expo:${:-}-value-start}#)
+ (immutable |${:-}-value-end| #{expo:${:-}-value-end}#)
+ (immutable |${:-}-value-parts| #{expo:${:-}-value-parts}#))
(sealed #t)
(opaque #t)
(protocol
(lambda (%make)
- (lambda (#{${:-}-name-start}# #{${:-}-name-end}#
- #{${:-}-value-start}# #{${:-}-value-end}#
- #{${:-}-value-parts}#)
+ (lambda (|${:-}-name-start| #{${:-}-name-end}#
+ |${:-}-value-start| #{${:-}-value-end}#
+ |${:-}-value-parts|)
"@var{$@{:-@}-name-start} (inclusive) and @var{$@{:-@}-name-end}
(exclusive) are the start and end positions of a variable name in an expansion
@samp{$@{VAR:-DEFAULT-VALUE@}}. @var{$@{:-@}-value-start} (inclusive) and
@@ -300,17 +300,17 @@ DEFAULT-VALUE. @var{${:-}-value-parts} is an ordered
list of contiguous
expansion position objects, representing the structure of @samp{DEFAULT-VALUE}
(unverified)."
(assert (and (exact-integers?
- #{${:-}-name-start}# #{${:-}-name-end}#
- #{${:-}-value-start}# #{${:-}-value-end}#)
- (<= 0 #{${:-}-name-start}#)
- (< #{${:-}-name-start}# #{${:-}-name-end}#)
- (= (- #{${:-}-value-start}# #{${:-}-name-end}#) 2)
- (<= #{${:-}-value-start}# #{${:-}-value-end}#)
- (or (pair? #{${:-}-value-parts}#)
- (null? #{${:-}-value-parts}#))))
- (%make #{${:-}-name-start}# #{${:-}-name-end}#
- #{${:-}-value-start}# #{${:-}-value-end}#
- #{${:-}-value-parts}#)))))
+ |${:-}-name-start| #{${:-}-name-end}#
+ |${:-}-value-start| #{${:-}-value-end}#)
+ (<= 0 |${:-}-name-start|)
+ (< |${:-}-name-start| #{${:-}-name-end}#)
+ (= (- |${:-}-value-start| #{${:-}-name-end}#) 2)
+ (<= |${:-}-value-start| #{${:-}-value-end}#)
+ (or (pair? |${:-}-value-parts|)
+ (null? |${:-}-value-parts|))))
+ (%make |${:-}-name-start| #{${:-}-name-end}#
+ |${:-}-value-start| #{${:-}-value-end}#
+ |${:-}-value-parts|)))))
;; Now define the possible syntax errors.
(define-condition-type &expansion-violation &lexical
@@ -334,7 +334,7 @@ expansions with a default, @code{$@{@}} for braced variable
expansions without
default and @code{$} for unbraced variable expansions."
(assert (and (exact-integers? position)
(<= 0 position)
- (memq kind '($ #{${}}# #{${:-}}#))))
+ (memq kind '($ |${}| #{${:-}}#))))
(%make-empty-variable-violation position kind))
(define-condition-type &missing-close &expansion-violation
@@ -349,7 +349,7 @@ indicates the type of variable expansion found, as in
@code{empty-variable-violation}, though it cannot be @code{$@}."
(assert (and (exact-integers? position)
(<= 0 position)
- (memq kind '(#{${}}# #{${:-}}#))))
+ (memq kind '(|${}| #{${:-}}#))))
(%make-missing-close-violation position kind))
(define cs::-or-close (char-set #\: #\}))
@@ -432,7 +432,7 @@ If @var{nested?} is Scheme-falsish, then the second return
value is simply
;; There should eventually be at least
;; a closing }.
(? (not name-end)
- (raise (make-missing-close-violation end '#{${}}#)))
+ (raise (make-missing-close-violation end '|${}|)))
(! name-end-character
(string-ref text name-end))
;; Empty variable names are not allowed.
@@ -440,13 +440,13 @@ If @var{nested?} is Scheme-falsish, then the second
return value is simply
(raise (make-empty-variable-violation
name-end
(if (char=? name-end-character #\:)
- '#{${:-}}#
- '#{${}}#))))
+ '|${:-}|
+ '|${}|))))
;; Was this ${NAME}?
(? (char=? name-end-character #\})
;; Then add it to @var{accumulated} and
;; continue.
- (loop (cons (#{make-${}-position}# name-start
name-end)
+ (loop (cons (|make-${}-position| name-start name-end)
accumulated)
(+ 1 name-end)))
;; Otherwise, it was ${NAME:-VALUE}.
@@ -462,7 +462,7 @@ If @var{nested?} is Scheme-falsish, then the second return
value is simply
;; This procedure call will verify a close
;; brace at @var{default-end} exist.
(<-- (value-parts value-end)
- (parse-expandable* text value-start end '#{${:-}}#))
+ (parse-expandable* text value-start end '|${:-}|))
;; This was violated at some draft of this procedure.
;; Verify it is fixed.
(!! (or (pair? value-parts)
@@ -472,7 +472,7 @@ If @var{nested?} is Scheme-falsish, then the second return
value is simply
(!! (char=? #\} (string-ref text value-end))))
;; Add the variable expansion to @var{accumulated}
;; and continue.
- (loop (cons (#{make-${:-}-position}# name-start name-end
+ (loop (cons (|make-${:-}-position| name-start name-end
value-start value-end value-parts)
accumulated)
;; + 1: eat the closing brace.
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index d2f3500..f2088ac 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -51,14 +51,14 @@
;; Network message manipulation procedures
;; (these belong to (gnu gnunet dht network)).
- (rename (construct-client-get #{ construct-client-get}#)
- (construct-client-get-stop #{ construct-client-get-stop}#)
- (construct-client-put #{ construct-client-put}#)
- (construct-client-result #{ construct-client-result}#)
- (analyse-client-get #{ analyse-client-get}#)
- (analyse-client-get-stop #{ analyse-client-get-stop}#)
- (analyse-client-put #{ analyse-client-put}#)
- (analyse-client-result #{ analyse-client-result}#))
+ (rename (construct-client-get | construct-client-get|)
+ (construct-client-get-stop | construct-client-get-stop|)
+ (construct-client-put | construct-client-put|)
+ (construct-client-result | construct-client-result|)
+ (analyse-client-get | analyse-client-get|)
+ (analyse-client-get-stop | analyse-client-get-stop|)
+ (analyse-client-put | analyse-client-put|)
+ (analyse-client-result | analyse-client-result|))
(rename (server:dht? server?))
diff --git a/gnu/gnunet/dht/network.scm b/gnu/gnunet/dht/network.scm
index c42aa63..cb8dfe6 100644
--- a/gnu/gnunet/dht/network.scm
+++ b/gnu/gnunet/dht/network.scm
@@ -20,11 +20,11 @@
(export construct-client-get construct-client-put construct-client-result
analyse-client-get analyse-client-put analyse-client-result)
(import (rename (gnu gnunet dht client)
- (#{ construct-client-get}# construct-client-get)
- (#{ construct-client-get-stop}# construct-client-get-stop)
- (#{ construct-client-put}# construct-client-put)
- (#{ construct-client-result}# construct-client-result)
- (#{ analyse-client-get}# analyse-client-get)
- (#{ analyse-client-get-stop}# analyse-client-get-stop)
- (#{ analyse-client-put}# analyse-client-put)
- (#{ analyse-client-result}# analyse-client-result))))
+ (| construct-client-get| construct-client-get)
+ (| construct-client-get-stop| construct-client-get-stop)
+ (| construct-client-put| construct-client-put)
+ (| construct-client-result| construct-client-result)
+ (| analyse-client-get| analyse-client-get)
+ (| analyse-client-get-stop| analyse-client-get-stop)
+ (| analyse-client-put| analyse-client-put)
+ (| analyse-client-result| analyse-client-result))))
diff --git a/gnu/gnunet/mq.scm b/gnu/gnunet/mq.scm
index 83c409e..7e00eb1 100644
--- a/gnu/gnunet/mq.scm
+++ b/gnu/gnunet/mq.scm
@@ -81,7 +81,7 @@
(prefix (only (pfds queues)
make-queue dequeue enqueue queue-length
queue-empty? queue->list list->queue)
- #{pfds:}#))
+ |pfds:|))
(begin
(define-record-type (<message-queue> make-message-queue message-queue?)
(fields (immutable handlers message-queue-handlers)
diff --git a/tests/config-expand.scm b/tests/config-expand.scm
index 510481d..22ac32b 100644
--- a/tests/config-expand.scm
+++ b/tests/config-expand.scm
@@ -83,14 +83,14 @@
(expand->string (alist->query `(("var" "variable"
(,(make-literal-position 3 8)))))
region=?/not "${var}"
- (list (#{make-${}-position}# 2 5))))
+ (list (|make-${}-position| 2 5))))
(test-equal "variable reference (${:-})"
"iable"
(expand->string (alist->query `(("var" "variable"
(,(make-literal-position 3 8)))))
region=?/not "${var:-default}"
- (list (#{make-${:-}-position}# 2 5 7 14 '()))))
+ (list (|make-${:-}-position| 2 5 7 14 '()))))
;; This is the expander, not the parser.
(test-equal "expander does not care about delimiters ($)"
@@ -105,20 +105,20 @@
(expand->string (alist->query `(("#@}!/" "variable"
(,(make-literal-position 3 8)))))
region=?/not "${pre}#@}!/${post}"
- (list (#{make-${}-position}# 6 11))))
+ (list (|make-${}-position| 6 11))))
(test-equal "expander does not care about delimiters (${:-})"
"iable"
(expand->string (alist->query `(("#@}!/" "variable"
(,(make-literal-position 3 8)))))
region=?/not "${pre}#@}!/${post}"
- (list (#{make-${:-}-position}# 6 11 13 15 '()))))
+ (list (|make-${:-}-position| 6 11 13 15 '()))))
(test-equal "undefined variable -> default (${:-})"
"default"
(expand->string (alist->query '(("var")))
region=?/not "var default"
- (list (#{make-${:-}-position}# 0 3 5 12
+ (list (|make-${:-}-position| 0 3 5 12
(list (make-literal-position 5 12))))))
(test-equal "undefined variable -> default (${:-}, recursive)"
@@ -127,7 +127,7 @@
("var2" "default"
(,(make-literal-position 0 7)))))
region=?/not "var var2"
- (list (#{make-${:-}-position}# 0 3 5 9
+ (list (|make-${:-}-position| 0 3 5 9
(list (make-$-position 5 9))))))
;; ยง Exceptions (undefined variable)
@@ -167,7 +167,7 @@
(end 3))
(expand->string/catch (alist->query '(("var")))
region=?/not "var"
- (list (#{make-${}-position}# 0 3))))
+ (list (|make-${}-position| 0 3))))
;; Like @code{region=?}, but #(line start end) must be in @var{acceptable}.
(define (region=?/restricted . acceptable)
@@ -199,7 +199,7 @@
(start 9)
(end 13))
(expand->string/catch (alist->query `(("var1" "var1 = ${var2}"
- (,(#{make-${}-position}# 9 13)))
+ (,(|make-${}-position| 9 13)))
("var2")))
(region=?/restricted
#("$var1" 1 5)
@@ -237,16 +237,16 @@
#("$var" 1 4)))
(expand->string/catch (alist->query `(("variable"
"variable = ${var}"
- (,(#{make-${}-position}# 13 16)))
+ (,(|make-${}-position| 13 16)))
("var"
"var = the ${variable}"
- (,(#{make-${}-position}# 12 20)))))
+ (,(|make-${}-position| 12 20)))))
(region=?/restricted
#("variable = ${var}" 13 16)
#("var = the ${variable}" 12 20)
#("$var" 1 4))
"$var"
- (list (#{make-$-position}# 1 4))))
+ (list (|make-$-position| 1 4))))
(test-equal "loop (${:-}, ${:-})"
@@ -257,10 +257,10 @@
(expand->string/catch
(alist->query `(("variable"
"variable = ${var:-}"
- (,(#{make-${:-}-position}# 13 16 18 18 '())))
+ (,(|make-${:-}-position| 13 16 18 18 '())))
("var"
"var = the ${variable:-}"
- (,(#{make-${:-}-position}# 12 20 22 22 '())))))
+ (,(|make-${:-}-position| 12 20 22 22 '())))))
(region=?/restricted
#("variable = ${var:-}" 13 16)
#("var = the ${variable:-}" 12 20)
@@ -280,7 +280,7 @@
#("var = $var" 7 10)
#("${does-not-exist:-$var}" 19 22))
"${does-not-exist:-$var}"
- (list (#{make-${:-}-position}# 2 16 18 22
+ (list (|make-${:-}-position| 2 16 18 22
(list (make-$-position 19 22))))))
;; This should _not_ lead to an &expansion-loop-error.
diff --git a/tests/config-parser.scm b/tests/config-parser.scm
index 705132b..214157a 100644
--- a/tests/config-parser.scm
+++ b/tests/config-parser.scm
@@ -38,15 +38,15 @@
(define (lipo=? x y)
"Are two line position objects equal?"
(cond/pos (x y)
- (#{%-position?}# position:%)
- (#{#-position?}# position:#)
+ (|%-position?| position:%)
+ (|#-position?| position:#)
(=-position?
position:variable-start
position:variable-end
position:=
position:value-start
position:value-end)
- (#{[]-position?}#
+ (|[]-position?|
position:section-name-start
position:section-name-end)
(@inline@-position?
@@ -67,39 +67,39 @@
(test-lipo "empty line: tab" "\t" #t)
(test-lipo "section name" "[hello]"
- (#{make-[]-position}# 1 6))
+ (|make-[]-position| 1 6))
(test-lipo "section name with spaces" "[ hello ]"
- (#{make-[]-position}# 1 9))
+ (|make-[]-position| 1 9))
;; Used for some services.
(test-lipo "section name with dots" "[hell.o.gnu]"
- (#{make-[]-position}# 1 11))
+ (|make-[]-position| 1 11))
;; Allowed in upstream.
(test-lipo "section name with leading space" "\t[hello]"
- (#{make-[]-position}# 2 7))
+ (|make-[]-position| 2 7))
(test-lipo "section name with more leading space" "\t [hello]"
- (#{make-[]-position}# 3 8))
+ (|make-[]-position| 3 8))
(test-lipo "section name with trailing space" "[hello]\t"
- (#{make-[]-position}# 1 6))
+ (|make-[]-position| 1 6))
(test-lipo "section name with more trailing space" "[hello]\t\t"
- (#{make-[]-position}# 1 6))
+ (|make-[]-position| 1 6))
(test-lipo "section name with missing ]" "[hell" #f)
(test-lipo "section name with missing [" "hell]" #f)
-(test-lipo "empty % comment" "%" (#{make-%-position}# 0))
-(test-lipo "empty # comment" "#" (#{make-#-position}# 0))
-(test-lipo "% comment with text" "%text" (#{make-%-position}# 0))
-(test-lipo "# comment with text" "#text" (#{make-#-position}# 0))
+(test-lipo "empty % comment" "%" (|make-%-position| 0))
+(test-lipo "empty # comment" "#" (|make-#-position| 0))
+(test-lipo "% comment with text" "%text" (|make-%-position| 0))
+(test-lipo "# comment with text" "#text" (|make-#-position| 0))
(test-lipo "% comment with leading whitespace" " %text"
- (#{make-%-position}# 1))
+ (|make-%-position| 1))
(test-lipo "# comment with leading whitespace" " #text"
- (#{make-#-position}# 1))
+ (|make-#-position| 1))
(test-lipo "% comment with more leading whitespace" " \t%text"
- (#{make-%-position}# 2))
+ (|make-%-position| 2))
(test-lipo "# comment with more leading whitespace" " \t#text"
- (#{make-#-position}# 2))
-(test-lipo "# comment with %" "#%stuff" (#{make-#-position}# 0))
-(test-lipo "% comment with #" "%#stuff" (#{make-%-position}# 0))
+ (|make-#-position| 2))
+(test-lipo "# comment with %" "#%stuff" (|make-#-position| 0))
+(test-lipo "% comment with #" "%#stuff" (|make-%-position| 0))
(test-lipo "= not allowed with empty variable name" "=value" #f)
(test-lipo "even with spaces" " =value" #f)
@@ -207,13 +207,13 @@ in-bounds for the string @var{line}."
(cond ((%-position? pos)
(and (<= 0 (position:% pos))
(< (position:% pos) (string-length line))))
- ((#{#-position?}# pos)
- (and (<= 0 (#{position:#}# pos))
- (< (#{position:#}# pos) (string-length line))))
+ ((|#-position?| pos)
+ (and (<= 0 (|position:#| pos))
+ (< (|position:#| pos) (string-length line))))
((=-position? pos)
(and (<= 0 (position:= pos))
(< (position:= pos) (string-length line))))
- ((#{[]-position?}# pos)
+ ((|[]-position?| pos)
(and (<= 0 (position:section-name-start pos)
(position:section-name-end pos))
(< (position:section-name-end pos)
@@ -273,12 +273,12 @@ in-bounds for the string @var{line}."
(define (expo:start expo)
"Given a position object, return the starting position of
the region of text it covers."
- (cond ((#{${:-}-position?}# expo)
+ (cond ((|${:-}-position?| expo)
;; - 2: remove the ${ in ${VAR:-DEFAULT}
- (- (#{expo:${:-}-name-start}# expo) 2))
- ((#{${}-position?}# expo)
+ (- (|expo:${:-}-name-start| expo) 2))
+ ((|${}-position?| expo)
;; - 2: remove the ${ in ${VAR}
- (- (#{expo:${}-name-start}# expo) 2))
+ (- (|expo:${}-name-start| expo) 2))
(($-position? expo)
;; - 1: remove the $ in $VAR
(- (expo:$-name-start expo) 1))
@@ -288,12 +288,12 @@ the region of text it covers."
(define (expo:end expo)
"Given a position object, return the end position (exclusive) of
the region of text it covers."
- (cond ((#{${:-}-position?}# expo)
+ (cond ((|${:-}-position?| expo)
;; + 1: add the } in ${VAR:-DEFAULT}
- (+ 1 (#{expo:${:-}-value-end}# expo) 1))
- ((#{${}-position?}# expo)
+ (+ 1 (|expo:${:-}-value-end| expo) 1))
+ ((|${}-position?| expo)
;; + 1: add the } in ${VAR}
- (+ (#{expo:${}-name-end}# expo) 1))
+ (+ (|expo:${}-name-end| expo) 1))
(($-position? expo)
(expo:$-name-end expo))
((literal-position? expo)
@@ -304,12 +304,12 @@ the region of text it covers."
If so, return the last object in @var{expos}. Otherwise, return
@code{#f}."
(define (internally-contiguous? x)
- (cond ((#{${:-}-position?}# x)
- (let ((parts (#{expo:${:-}-value-parts}# x)))
+ (cond ((|${:-}-position?| x)
+ (let ((parts (|expo:${:-}-value-parts| x)))
(if (null? parts)
x
(expo:contiguous? parts))))
- ((#{${}-position?}# x) #t)
+ ((|${}-position?| x) #t)
(($-position? x) #t)
((literal-position? x) #t)
(#t (error "what is this madness?"))))
@@ -325,7 +325,7 @@ If so, return the last object in @var{expos}. Otherwise,
return
(char-set->arbitrary (string->char-set "${:-}ab")))
(define-syntax-rule ($choose-with-eq? x ...)
($choose ((cute eq? x) ($const x)) ...))
-(define $nested ($choose-with-eq? #f '#{${}}# '#{${:-}}#))
+(define $nested ($choose-with-eq? #f '|${}| '#{${:-}}#))
(define-syntax-rule (true-if-parse-error exp exp* ...)
(with-exception-handler
@@ -407,20 +407,20 @@ is invariant under translations."
(($-position? pos)
`($ ,(- (expo:$-name-start pos) start)
,(- (expo:$-name-end pos) start)))
- ((#{${}-position?}# pos)
- `(#{${}}#
- ,(- (#{expo:${}-name-start}# pos) start)
- ,(- (#{expo:${}-name-end}# pos) start)))
+ ((|${}-position?| pos)
+ `(|${}|
+ ,(- (|expo:${}-name-start| pos) start)
+ ,(- (|expo:${}-name-end| pos) start)))
;; HACK: work-around buggy Emacs parenthesis
;; matching detection.
- ((#{${:-}-position?}# pos)
+ ((|${:-}-position?| pos)
`(,(string->symbol "${:-}")
- ,(- (#{expo:${:-}-name-start}# pos) start)
- ,(- (#{expo:${:-}-name-end}# pos) start)
- ,(- (#{expo:${:-}-value-start}# pos) start)
- ,(- (#{expo:${:-}-value-end}# pos) start)
+ ,(- (|expo:${:-}-name-start| pos) start)
+ ,(- (|expo:${:-}-name-end| pos) start)
+ ,(- (|expo:${:-}-value-start| pos) start)
+ ,(- (|expo:${:-}-value-end| pos) start)
,(map (cute expansible->sexp <> start)
- (#{expo:${:-}-value-parts}# pos))))))
+ (|expo:${:-}-value-parts| pos))))))
(test-assert "start and end are respected"
(quickcheck
@@ -477,12 +477,12 @@ is invariant under translations."
(= (expansion-violation-position c) 5)))
;; Test unbraced variable expansion, nested.
-(test-expansion-error ("$ + }, nested" '#{${:-}}#)
+(test-expansion-error ("$ + }, nested" '|${:-}|)
(c "$}")
(and (empty-variable-violation? c)
(eq? (empty-variable-kind c) '$)
(= (expansion-violation-position c) 1)))
-(test-expansion-error ("$ + } + delimiter, nested" '#{${:-}}#)
+(test-expansion-error ("$ + } + delimiter, nested" '|${:-}|)
;; don't interpret this as the variable } expanded
;; folowed by a slash!
(c "$}/")
@@ -494,32 +494,32 @@ is invariant under translations."
(test-expansion-error ("empty braced variable" #f)
(c "${}")
(and (empty-variable-violation? c)
- (eq? (empty-variable-kind c) '#{${}}#)
+ (eq? (empty-variable-kind c) '|${}|)
(= (expansion-violation-position c) 2)))
(test-expansion-error ("empty braced variable with empty default" #f)
(c "${:-}")
(and (empty-variable-violation? c)
- (eq? (empty-variable-kind c) '#{${:-}}#)
+ (eq? (empty-variable-kind c) '|${:-}|)
(= (expansion-violation-position c) 2)))
(test-expansion-error ("empty braced variable with nonempty default" #f)
(c "${:-def}")
(and (empty-variable-violation? c)
- (eq? (empty-variable-kind c) '#{${:-}}#)
+ (eq? (empty-variable-kind c) '|${:-}|)
(= (expansion-violation-position c) 2)))
(test-expansion-error ("unclosed braced variable" #f)
(c "${")
(and (missing-close-violation? c)
- (eq? (missing-close-kind c) '#{${}}#)
+ (eq? (missing-close-kind c) '|${}|)
(= (expansion-violation-position c) 2)))
(test-expansion-error ("unclosed braced variable with text" #f)
(c "${text")
(and (missing-close-violation? c)
- (eq? (missing-close-kind c) '#{${}}#)
+ (eq? (missing-close-kind c) '|${}|)
(= (expansion-violation-position c) 6)))
(test-expansion-error ("unclosed braced variable with default" #f)
(c "${text:-default")
(and (missing-close-violation? c)
- (eq? (missing-close-kind c) '#{${:-}}#)
+ (eq? (missing-close-kind c) '|${:-}|)
(= (expansion-violation-position c) 15)))
(test-expansion-error ("unclosed braced variable and weird character after -"
#f)
(c "${text:@") ; <-- allowed in upstream
@@ -541,21 +541,21 @@ is invariant under translations."
(test-expansion "$TMP/gnunet_arm.sock"
(make-$-position 1 4)
(make-literal-position 4 20))
-(test-expansion "${TMP}" (#{make-${}-position}# 2 5))
+(test-expansion "${TMP}" (|make-${}-position| 2 5))
(test-expansion "${TMP}/gnunet_arm.sock"
- (#{make-${}-position}# 2 5)
+ (|make-${}-position| 2 5)
(make-literal-position 6 22))
(test-expansion "${TMP:-/tmp}"
- (#{make-${:-}-position}# 2 5 7 11
+ (|make-${:-}-position| 2 5 7 11
(list (make-literal-position 7 11))))
(test-expansion "${TMP:-/tmp}/gnunet_arm.sock"
- (#{make-${:-}-position}# 2 5 7 11
+ (|make-${:-}-position| 2 5 7 11
(list (make-literal-position 7 11)))
(make-literal-position 12 28))
(test-expansion "some ${STUFF:-${TMP:-/tmp}/etc$etera}/other"
(make-literal-position 0 5)
- (#{make-${:-}-position}# 7 12 14 36
- (list (#{make-${:-}-position}# 16 19 21 25
+ (|make-${:-}-position| 7 12 14 36
+ (list (|make-${:-}-position| 16 19 21 25
(list (make-literal-position 21 25)))
(make-literal-position 26 30)
(make-$-position 31 36)))
diff --git a/tests/lost-and-found.scm b/tests/lost-and-found.scm
index 908f72b..91942bd 100644
--- a/tests/lost-and-found.scm
+++ b/tests/lost-and-found.scm
@@ -154,7 +154,7 @@
;; also allowed.
(memq result '(blocking ()))))
-(define add-found! #{ add-found!}#)
+(define add-found! | add-found!|)
;; There is no rule against the GC hook being called from within the GC hook,
;; or the GC hook being called in parallel from another thread running the
diff --git a/tests/network-size.scm b/tests/network-size.scm
index 7e3e352..ddeef8b 100644
--- a/tests/network-size.scm
+++ b/tests/network-size.scm
@@ -26,7 +26,7 @@
(gnu gnunet utils cut-syntax)
(only (rnrs base)
assert)
- (prefix (gnu gnunet nse client) #{nse:}#)
+ (prefix (gnu gnunet nse client) |nse:|)
(gnu gnunet nse struct)
(only (gnu gnunet utils bv-slice)
slice-length make-slice/read-write)
@@ -36,7 +36,7 @@
(ice-9 match)
(ice-9 suspendable-ports)
(ice-9 control)
- (prefix (rnrs hashtables) #{rnrs:}#)
+ (prefix (rnrs hashtables) |rnrs:|)
(srfi srfi-1)
(srfi srfi-26)
(srfi srfi-43)
@@ -49,7 +49,7 @@
(test-assert "close, not connected --> all fibers stop, no callbacks called"
(close-not-connected-no-callbacks
"nse" nse:connect nse:disconnect!
- #:rest (list #:disconnected #{don't-call-me}#)))
+ #:rest (list #:disconnected |don't-call-me|)))
(test-assert "garbage collectable"
(garbage-collectable "nse" nse:connect))
@@ -204,7 +204,7 @@
(lambda (somewhere)
(define where (in-vicinity somewhere "sock.et"))
(define config (trivial-service-config "nse" where))
- (define (#{don't-call-me}# . rest)
+ (define (|don't-call-me| . rest)
(error "oops ~a" rest))
(define connected? #f)
(define disconnected? #f)
@@ -223,7 +223,7 @@
(define server (nse:connect config #:spawn spawn
#:connected connected
#:disconnected disconnected
- #:updated #{don't-call-me}#))
+ #:updated |don't-call-me|))
(define listening (socket AF_UNIX SOCK_STREAM 0))
(make-nonblocking! listening)
(bind listening AF_UNIX where)
diff --git a/tests/utils.scm b/tests/utils.scm
index ac43e6f..40329c9 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -19,11 +19,11 @@
#:use-module (srfi srfi-8)
#:use-module (ice-9 match)
#:use-module (ice-9 weak-vector)
- #:use-module ((rnrs hashtables) #:prefix #{rnrs:}#)
+ #:use-module ((rnrs hashtables) #:prefix |rnrs:|)
#:use-module ((rnrs arithmetic bitwise)
#:select (bitwise-ior))
#:use-module ((rnrs base) #:select (assert))
- #:use-module ((fibers) #:prefix #{fibers:}#)
+ #:use-module ((fibers) #:prefix |fibers:|)
#:autoload (fibers conditions) (make-condition signal-condition! wait)
#:autoload (fibers timers) (sleep)
#:autoload (gnu gnunet config db)
@@ -39,7 +39,7 @@
make-nonblocking!
call-with-absent-service
trivial-service-config
- #{don't-call-me}#
+ |don't-call-me|
close-not-connected-no-callbacks
garbage-collectable
disconnect-after-eof-after-connected
@@ -210,7 +210,7 @@ cannot be connected to."
(define config (trivial-service-config what where))
(proc config))))
-(define (#{don't-call-me}# . rest)
+(define (|don't-call-me| . rest)
(error "oops ~a" rest))
(define* (close-not-connected-no-callbacks service connect disconnect!
@@ -224,8 +224,8 @@ callbacks were not called. Also verify that all spawned
fibers exit."
service
(lambda (config)
(define server (apply connect config #:spawn spawn
- #:connected #{don't-call-me}#
- #:disconnected #{don't-call-me}#
+ #:connected |don't-call-me|
+ #:disconnected |don't-call-me|
rest))
;; Sleep to give the client fibers a chance to mistakenly
;; call a callback.
@@ -252,8 +252,8 @@ fiber exit and the fibers do not keep a reference to the
service object."
(lambda (config)
(define reference
(weak-vector
- (connect config #:spawn spawn #:connected #{don't-call-me}#
- #:disconnected #{don't-call-me}#)))
+ (connect config #:spawn spawn #:connected |don't-call-me|
+ #:disconnected |don't-call-me|)))
;; Sleep to give the client fibers a chance to mistakenly
;; call a callback and to allow the fibers to actually stop.
(let loop ((delay 0.0005))
--
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.
- [gnunet-scheme] 03/16: hat-let: Port to Racket Scheme., (continued)
- [gnunet-scheme] 03/16: hat-let: Port to Racket Scheme., gnunet, 2022/09/05
- [gnunet-scheme] 04/16: Add infrastructure for Racketifying source code., gnunet, 2022/09/05
- [gnunet-scheme] 09/16: SCM_LOG_DRIVER., gnunet, 2022/09/05
- [gnunet-scheme] 12/16: Makefile.am: Reuse old .ss when still good., gnunet, 2022/09/05
- [gnunet-scheme] 11/16: Don't mutate source files, instead make new ones., gnunet, 2022/09/05
- [gnunet-scheme] 10/16: tests/form: Use Unicode escapes instead of the unportable \x...., gnunet, 2022/09/05
- [gnunet-scheme] 07/16: Makefile.am: Enable --r7rs, for the r7rs-symbols., gnunet, 2022/09/05
- [gnunet-scheme] 05/16: Add ;#!r6rs comments., gnunet, 2022/09/05
- [gnunet-scheme] 14/16: Merge branch 'racket-port', gnunet, 2022/09/05
- [gnunet-scheme] 15/16: Update version number., gnunet, 2022/09/05
- [gnunet-scheme] 08/16: Use r7rs-symbols, for compatibility with Racket.,
gnunet <=
- [gnunet-scheme] 13/16: doc: Abandon the Racket port for now because of complications., gnunet, 2022/09/05
- [gnunet-scheme] 06/16: data-string: Port to Racket., gnunet, 2022/09/05
- [gnunet-scheme] 16/16: Update documentation indices., gnunet, 2022/09/05