brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Constant brmember tag, fix tests.

Browse source
This commit is contained in:
Dominik Pantůček 2023-04-13 20:22:56 +02:00
parent 0052dd0b75
commit 287e5fd83b
1 changed files with 10 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

13
src/brmember.scm
View file

@ -29,6 +29,8 @@
(module (module
brmember brmember
( (
TAG-BRMEMBER
make-brmember make-brmember
brmember-file-name brmember-file-name
@ -88,6 +90,9 @@
bank-account bank-account
util-tag) util-tag)
;; Unique tag
(define TAG-BRMEMBER (make-tag BRMEMBER))
;; Checks whether given string is a 4-digit decimal number. ;; Checks whether given string is a 4-digit decimal number.
(define (is-4digit-string? s) (define (is-4digit-string? s)
(if (irregex-search (irregex "^[0-9]{4}$") s) (if (irregex-search (irregex "^[0-9]{4}$") s)
@ -120,7 +125,7 @@
(symbol->string (symbol->string
(get-4digit-symbol-from-list (cons file-name symlinks)))))))) (get-4digit-symbol-from-list (cons file-name symlinks))))))))
(if (null? args) (if (null? args)
(make-ldict (cons (cons 'TAG (make-tag BRMEMBER)) (make-ldict (cons (cons 'TAG TAG-BRMEMBER)
pairs)) pairs))
(if (not (keyword? (car args))) (if (not (keyword? (car args)))
(error 'make-brmember "Optional arguments must be keywords" (car args)) (error 'make-brmember "Optional arguments must be keywords" (car args))
@ -358,7 +363,8 @@
(ldict-equal? (ldict-equal?
(make-brmember '|1234| "members/1234" '(|member|)) (make-brmember '|1234| "members/1234" '(|member|))
(make-ldict (make-ldict
'((file-name . |1234|) `((file-name . |1234|)
(TAG . ,TAG-BRMEMBER)
(file-path . "members/1234") (file-path . "members/1234")
(symlinks |member|) (symlinks |member|)
(id . 1234))))) (id . 1234)))))
@ -366,7 +372,8 @@
(ldict-equal? (ldict-equal?
(make-brmember '|1234| "members/1234" '(|member|) #:msg "msg") (make-brmember '|1234| "members/1234" '(|member|) #:msg "msg")
(make-ldict (make-ldict
'((msg . "msg") `((msg . "msg")
(TAG . ,TAG-BRMEMBER)
(file-name . |1234|) (file-name . |1234|)
(file-path . "members/1234") (file-path . "members/1234")
(symlinks |member|) (symlinks |member|)