aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMatěj Cepl <mcepl@cepl.eu>2023-08-03 10:14:49 +0200
committerMatěj Cepl <mcepl@cepl.eu>2023-08-11 11:59:02 +0200
commit36aed204ea52b6dbde81031a15fcfb1926e9e37c (patch)
tree0920e36b90d1c30ce7d7037c9651c8f111b69c8a
parentedbd8b5849e7da1ddceb49368b431d4862408efd (diff)
downloadpinentry-rofi-36aed204ea52b6dbde81031a15fcfb1926e9e37c.tar.gz
feat: first attempts for testing infrastructure.
-rw-r--r--tests/foundational.bats11
-rwxr-xr-xtests/pinentry-rofi.bats457
-rwxr-xr-xtests/pinentry-rofi.scm459
3 files changed, 468 insertions, 459 deletions
diff --git a/tests/foundational.bats b/tests/foundational.bats
new file mode 100644
index 0000000..5683371
--- /dev/null
+++ b/tests/foundational.bats
@@ -0,0 +1,11 @@
+#!/usr/bin/env bats
+
+@test "addition using bc" {
+ result="$(echo 2+2 | bc)"
+ [ "$result" -eq 4 ]
+}
+
+@test "addition using dc" {
+ result="$(echo 2 2+p | dc)"
+ [ "$result" -eq 4 ]
+}
diff --git a/tests/pinentry-rofi.bats b/tests/pinentry-rofi.bats
new file mode 100755
index 0000000..8c7748e
--- /dev/null
+++ b/tests/pinentry-rofi.bats
@@ -0,0 +1,457 @@
+#!/usr/bin/env bats
+
+## (define-module (tests-pinentry-rofi)
+## #:use-module (srfi srfi-64)
+## #:use-module (ice-9 popen)
+## #:use-module (ice-9 textual-ports)
+## #:use-module (pinentry-rofi))
+
+# XXX (test-begin "pinentry-rofi")
+
+# XXX ;; (test-begin "pinentry")
+# XXX (let ((pinentry (make-pinentry #t "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
+# XXX (test-assert (pinentry? pinentry))
+# XXX (test-assert (pinentry-ok pinentry))
+# XXX (test-equal "Prompt" (pinentry-prompt pinentry))
+# XXX (test-equal "Ok" (pinentry-ok-button pinentry))
+# XXX (test-equal "Cancel" (pinentry-cancel-button pinentry))
+# XXX (test-equal ":1" (pinentry-display pinentry))
+# XXX (test-equal "test.log" (pinentry-logfile pinentry))
+# XXX (test-assert (not (pinentry-notok-button pinentry)))
+# XXX (test-assert (not (pinentry-visibility pinentry)))
+# XXX (test-assert (not (pinentry-error pinentry))))
+# XXX
+# XXX (let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
+# XXX (test-assert (not (pinentry-ok pinentry))))
+# XXX
+# XXX ;; (test-end "pinentry")
+# XXX
+# XXX ;; (test-begin "utils")
+# XXX
+# XXX (test-equal "Ok" (remove-underline "_Ok"))
+# XXX (test-equal " Ok" (remove-underline " _Ok"))
+# XXX (test-equal "foo_bar" (remove-underline "foo_bar"))
+# XXX (test-equal "foo__bar" (remove-underline "foo__bar"))
+# XXX (test-equal " __Ok" (remove-underline " __Ok"))
+# XXX (test-equal "__Ok" (remove-underline "__Ok"))
+# XXX (test-equal "Ok%0ACancel" (remove-underline "_Ok%0A_Cancel"))
+# XXX (test-equal "Ok&#10;Cancel" (remove-underline "_Ok&#10;_Cancel"))
+# XXX
+# XXX (test-equal "_Ok" (escape-underscore "_Ok"))
+# XXX (test-equal " _Ok" (escape-underscore " _Ok"))
+# XXX (test-equal "foo_bar" (escape-underscore "foo_bar"))
+# XXX (test-equal "foo__bar" (escape-underscore "foo__bar"))
+# XXX (test-equal " _Ok" (escape-underscore " __Ok"))
+# XXX (test-equal "_Ok" (escape-underscore "__Ok"))
+# XXX (test-equal "_Ok%0A_Cancel" (escape-underscore "__Ok%0A__Cancel"))
+# XXX (test-equal "_Ok&#10;_Cancel" (escape-underscore "__Ok&#10;__Cancel"))
+# XXX
+# XXX (test-assert (string-empty? ""))
+# XXX (test-assert (not (string-empty? "foo")))
+# XXX ;; (test-end "utils")
+# XXX
+# XXX (test-equal "This is one line\nThis is another%OA"
+# XXX (hex->char "%54his is one line%0AThis is another%OA"))
+# XXX
+# XXX ;; (test-begin "html")
+# XXX (test-equal "%54his is one line&#10;This is another%OA"
+# XXX (html-newline "%54his is one line%0AThis is another%OA"))
+# XXX (test-equal "%54his is one line\nThis is another%OA"
+# XXX (html-newline "%54his is one line\nThis is another%OA"))
+# XXX
+# XXX (test-equal "<u>O</u>k" (html-underline "_Ok"))
+# XXX (test-equal " <u>O</u>k" (html-underline " _Ok"))
+# XXX (test-equal "foo_bar" (html-underline "foo_bar"))
+# XXX (test-equal "foo__bar" (html-underline "foo__bar"))
+# XXX (test-equal " __Ok" (html-underline " __Ok"))
+# XXX (test-equal "__Ok" (html-underline "__Ok"))
+# XXX (test-equal "<u>O</u>k%0A<u>C</u>ancel" (html-underline "_Ok%0A_Cancel"))
+# XXX (test-equal "<u>O</u>k&#10;<u>C</u>ancel" (html-underline "_Ok&#10;_Cancel"))
+# XXX
+# XXX ;; (test-end "html")
+# XXX
+# XXX (test-equal "<u>T</u>his is one line&#10;<u>T</u>his is another%OA"
+# XXX (pango-markup "_%54his is one line%0A_This is another%OA"))
+# XXX
+# XXX (test-equal "Ok\nCancel"
+# XXX (input-string "_Ok\nCancel"))
+# XXX
+# XXX (test-equal "Ok\n_Cancel"
+# XXX (input-string "_Ok\n__Cancel"))
+# XXX
+# XXX (let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
+# XXX (pinentry-set set-pinentry-notok-button! pinentry "Not ok")
+# XXX (test-equal "Not ok" (pinentry-notok-button pinentry))
+# XXX (test-assert (pinentry-ok pinentry)))
+# XXX
+# XXX (let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
+# XXX (test-error #t (pinentry-set pinentry-notok-button pinentry "Not ok")))
+# XXX
+# XXX (let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
+# XXX (test-assert (pinentry-option pinentry "OPTION default-ok=Okay"))
+# XXX (test-equal "Okay" (pinentry-ok-button pinentry))
+# XXX (test-equal "Cancel" (pinentry-cancel-button pinentry))
+# XXX (test-equal "Prompt" (pinentry-prompt pinentry))
+# XXX (test-equal "C" (pinentry-lc-ctype pinentry))
+# XXX (test-equal "C" (pinentry-lc-messages pinentry))
+# XXX (test-assert (pinentry-ok pinentry)))
+# XXX
+# XXX (let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
+# XXX (test-assert (pinentry-option pinentry "OPTION default-cancel=No"))
+# XXX (test-equal "Ok" (pinentry-ok-button pinentry))
+# XXX (test-equal "No" (pinentry-cancel-button pinentry))
+# XXX (test-equal "Prompt" (pinentry-prompt pinentry))
+# XXX (test-equal "C" (pinentry-lc-ctype pinentry))
+# XXX (test-equal "C" (pinentry-lc-messages pinentry))
+# XXX (test-assert (pinentry-ok pinentry)))
+# XXX
+# XXX (let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
+# XXX (test-assert (pinentry-option pinentry "OPTION default-prompt=Password:"))
+# XXX (test-equal "Ok" (pinentry-ok-button pinentry))
+# XXX (test-equal "Cancel" (pinentry-cancel-button pinentry))
+# XXX (test-equal "Password:" (pinentry-prompt pinentry))
+# XXX (test-equal "C" (pinentry-lc-ctype pinentry))
+# XXX (test-equal "C" (pinentry-lc-messages pinentry))
+# XXX (test-assert (pinentry-ok pinentry)))
+# XXX
+# XXX (let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
+# XXX (test-assert (pinentry-option pinentry "OPTION lc-ctype=en_US.UTF-8"))
+# XXX (test-equal "Ok" (pinentry-ok-button pinentry))
+# XXX (test-equal "Cancel" (pinentry-cancel-button pinentry))
+# XXX (test-equal "Prompt" (pinentry-prompt pinentry))
+# XXX (test-equal "en_US.UTF-8" (pinentry-lc-ctype pinentry))
+# XXX (test-equal "C" (pinentry-lc-messages pinentry))
+# XXX (test-assert (pinentry-ok pinentry)))
+# XXX
+# XXX (let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
+# XXX (test-assert (pinentry-option pinentry "OPTION lc-messages=en_US.UTF-8"))
+# XXX (test-equal "Ok" (pinentry-ok-button pinentry))
+# XXX (test-equal "Cancel" (pinentry-cancel-button pinentry))
+# XXX (test-equal "Prompt" (pinentry-prompt pinentry))
+# XXX (test-equal "C" (pinentry-lc-ctype pinentry))
+# XXX (test-equal "en_US.UTF-8" (pinentry-lc-messages pinentry))
+# XXX (test-assert (pinentry-ok pinentry)))
+# XXX
+# XXX (let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
+# XXX (test-assert (pinentry-option pinentry "OPTION foo bar")))
+# XXX
+# XXX (let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
+# XXX (test-assert (not (pinentry-option pinentry " OPTION foo bar")))
+# XXX (test-assert (not (pinentry-option pinentry "OPTION")))
+# XXX (test-assert (not (pinentry-option pinentry "Foo"))))
+# XXX
+# XXX (let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C"))
+# XXX (output "")
+# XXX (fake-port (make-soft-port
+# XXX (vector
+# XXX (lambda (c) (set! output (string-append output c)))
+# XXX (lambda (s) (set! output (string-append output s)))
+# XXX (lambda () #t)
+# XXX #f
+# XXX (lambda () #t))
+# XXX "w")))
+# XXX (test-assert (pinentry-getinfo pinentry "GETINFO pid" #:port fake-port))
+# XXX (test-equal (format #f "D ~a\n" (getpid)) output)
+# XXX (test-assert (pinentry-getinfo pinentry "GETINFO foo bar"))
+# XXX (test-assert (not (pinentry-getinfo pinentry " GETINFO foo bar")))
+# XXX (test-assert (not (pinentry-getinfo pinentry "GETINFO")))
+# XXX (test-assert (not (pinentry-getinfo pinentry "Foo"))))
+# XXX
+# XXX (let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
+# XXX (test-assert (pinentry-setkeyinfo pinentry "SETKEYINFO Foo"))
+# XXX (test-assert (pinentry-ok pinentry))
+# XXX (test-assert (not (pinentry-setkeyinfo pinentry " SETKEYINFO foo bar")))
+# XXX (test-assert (not (pinentry-setkeyinfo pinentry "SETKEYINFO")))
+# XXX (test-assert (not (pinentry-setkeyinfo pinentry "Foo"))))
+# XXX
+# XXX (let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
+# XXX (test-assert (pinentry-setok pinentry "SETOK Foo"))
+# XXX (test-equal "Foo" (pinentry-ok-button pinentry))
+# XXX (test-assert (pinentry-ok pinentry))
+# XXX (test-assert (pinentry-setok pinentry "SETOK _Ok okay"))
+# XXX (test-equal "Ok okay" (pinentry-ok-button pinentry))
+# XXX (test-assert (not (pinentry-setok pinentry " SETOK foo bar")))
+# XXX (test-equal "Ok okay" (pinentry-ok-button pinentry))
+# XXX (test-assert (not (pinentry-setok pinentry "SETOK")))
+# XXX (test-equal "Ok okay" (pinentry-ok-button pinentry))
+# XXX (test-assert (not (pinentry-setok pinentry "Foo")))
+# XXX (test-equal "Ok okay" (pinentry-ok-button pinentry)))
+# XXX
+# XXX (let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
+# XXX (test-assert (pinentry-setnotok pinentry "SETNOTOK Foo"))
+# XXX (test-equal "Foo" (pinentry-notok-button pinentry))
+# XXX (test-assert (pinentry-ok pinentry))
+# XXX (test-assert (pinentry-setnotok pinentry "SETNOTOK Not _Ok"))
+# XXX (test-equal "Not Ok" (pinentry-notok-button pinentry))
+# XXX (test-assert (not (pinentry-setnotok pinentry " SETNOTOK foo bar")))
+# XXX (test-equal "Not Ok" (pinentry-notok-button pinentry))
+# XXX (test-assert (not (pinentry-setnotok pinentry "SETNOTOK")))
+# XXX (test-equal "Not Ok" (pinentry-notok-button pinentry))
+# XXX (test-assert (not (pinentry-setnotok pinentry "Foo")))
+# XXX (test-equal "Not Ok" (pinentry-notok-button pinentry)))
+# XXX
+# XXX (let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
+# XXX (test-assert (pinentry-setcancel pinentry "SETCANCEL Foo"))
+# XXX (test-equal "Foo" (pinentry-cancel-button pinentry))
+# XXX (test-assert (pinentry-ok pinentry))
+# XXX (test-assert (pinentry-setcancel pinentry "SETCANCEL _Abort"))
+# XXX (test-equal "Abort" (pinentry-cancel-button pinentry))
+# XXX (test-assert (not (pinentry-setcancel pinentry " SETCANCEL foo bar")))
+# XXX (test-equal "Abort" (pinentry-cancel-button pinentry))
+# XXX (test-assert (not (pinentry-setcancel pinentry "SETCANCEL")))
+# XXX (test-equal "Abort" (pinentry-cancel-button pinentry))
+# XXX (test-assert (not (pinentry-setcancel pinentry "Foo")))
+# XXX (test-equal "Abort" (pinentry-cancel-button pinentry)))
+# XXX
+# XXX (let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Desc" ":1" "test.log" "C" "C")))
+# XXX (test-assert (pinentry-setdesc pinentry "SETDESC Foo"))
+# XXX (test-equal "Foo" (pinentry-desc pinentry))
+# XXX (test-assert (pinentry-ok pinentry))
+# XXX (test-assert (pinentry-setdesc pinentry "SETDESC _%54his is a description%0A_On two lines"))
+# XXX (test-equal "<u>T</u>his is a description&#10;<u>O</u>n two lines" (pinentry-desc pinentry))
+# XXX (test-assert (not (pinentry-setdesc pinentry " SETDESC foo bar")))
+# XXX (test-equal "<u>T</u>his is a description&#10;<u>O</u>n two lines" (pinentry-desc pinentry))
+# XXX (test-assert (not (pinentry-setdesc pinentry "SETDESC")))
+# XXX (test-equal "<u>T</u>his is a description&#10;<u>O</u>n two lines" (pinentry-desc pinentry))
+# XXX (test-assert (not (pinentry-setdesc pinentry "Foo")))
+# XXX (test-equal "<u>T</u>his is a description&#10;<u>O</u>n two lines" (pinentry-desc pinentry)))
+# XXX
+# XXX (let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Error" ":1" "test.log" "C" "C")))
+# XXX (test-assert (pinentry-seterror pinentry "SETERROR Foo"))
+# XXX (test-equal "Foo" (pinentry-error pinentry))
+# XXX (test-assert (pinentry-ok pinentry))
+# XXX (test-assert (pinentry-seterror pinentry "SETERROR _%54his is an error%0A_On two lines"))
+# XXX (test-equal "<u>T</u>his is an error&#10;<u>O</u>n two lines" (pinentry-error pinentry))
+# XXX (test-assert (not (pinentry-seterror pinentry " SETERROR foo bar")))
+# XXX (test-equal "<u>T</u>his is an error&#10;<u>O</u>n two lines" (pinentry-error pinentry))
+# XXX (test-assert (not (pinentry-seterror pinentry "SETERROR")))
+# XXX (test-equal "<u>T</u>his is an error&#10;<u>O</u>n two lines" (pinentry-error pinentry))
+# XXX (test-assert (not (pinentry-seterror pinentry "Foo")))
+# XXX (test-equal "<u>T</u>his is an error&#10;<u>O</u>n two lines" (pinentry-error pinentry)))
+# XXX
+# XXX (let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Prompt" ":1" "test.log" "C" "C")))
+# XXX (test-assert (pinentry-setprompt pinentry "SETPROMPT Foo"))
+# XXX (test-equal "Foo" (pinentry-prompt pinentry))
+# XXX (test-assert (pinentry-ok pinentry))
+# XXX (test-assert (pinentry-setprompt pinentry "SETPROMPT _%54his is a prompt%0A_On two lines"))
+# XXX (test-equal "<u>T</u>his is a prompt&#10;<u>O</u>n two lines" (pinentry-prompt pinentry))
+# XXX (test-assert (not (pinentry-setprompt pinentry " SETPROMPT foo bar")))
+# XXX (test-equal "<u>T</u>his is a prompt&#10;<u>O</u>n two lines" (pinentry-prompt pinentry))
+# XXX (test-assert (not (pinentry-setprompt pinentry "SETPROMPT")))
+# XXX (test-equal "<u>T</u>his is a prompt&#10;<u>O</u>n two lines" (pinentry-prompt pinentry))
+# XXX (test-assert (not (pinentry-setprompt pinentry "Foo")))
+# XXX (test-equal "<u>T</u>his is a prompt&#10;<u>O</u>n two lines" (pinentry-prompt pinentry)))
+# XXX
+# XXX (let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Prompt" ":1" "test.log" "C" "C")))
+# XXX (test-error "(quit #t)" (pinentry-bye pinentry "BYE"))
+# XXX (test-assert (not (pinentry-bye pinentry "Hej då"))))
+# XXX
+# XXX (let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "en_US.UTF-8"))
+# XXX (output "")
+# XXX (fake-port (make-soft-port
+# XXX (vector
+# XXX (lambda (c) (set! output (string-append output c)))
+# XXX (lambda (s) (set! output (string-append output s)))
+# XXX (lambda () #t)
+# XXX #f
+# XXX (lambda () #t))
+# XXX "w"))
+# XXX (description "This is a description")
+# XXX (error "Something went wrong")
+# XXX (display ":1"))
+# XXX (set-pinentry-desc! pinentry description)
+# XXX (set-pinentry-display! pinentry display)
+# XXX (test-assert (pinentry-getpin pinentry "GETPIN"
+# XXX (lambda* (#:key (env '())
+# XXX visibility
+# XXX (prompt ">")
+# XXX message
+# XXX buttons
+# XXX only-match)
+# XXX (test-equal "Prompt" prompt)
+# XXX (test-equal description message)
+# XXX (test-assert (not visibility))
+# XXX (test-assert (not only-match))
+# XXX (test-assert (not buttons))
+# XXX (test-equal `(("DISPLAY" . ,display)
+# XXX ("LC_CTYPE" . "C")
+# XXX ("LC_MESSAGES" . "en_US.UTF-8"))
+# XXX env)
+# XXX "password")
+# XXX #:port fake-port))
+# XXX (test-equal (format #f "D password") output)
+# XXX (set-pinentry-error! pinentry error)
+# XXX (set! output "")
+# XXX (test-assert (pinentry-getpin pinentry "GETPIN"
+# XXX (lambda* (#:key (env '())
+# XXX visibility
+# XXX (prompt ">")
+# XXX message
+# XXX buttons
+# XXX only-match)
+# XXX (test-equal "Prompt" prompt)
+# XXX (test-equal (format #f "~a&#10;~a" error description)
+# XXX message)
+# XXX (test-assert (not visibility))
+# XXX (test-assert (not only-match))
+# XXX (test-assert (not buttons))
+# XXX (test-equal `(("DISPLAY" . ,display)
+# XXX ("LC_CTYPE" . "C")
+# XXX ("LC_MESSAGES" . "en_US.UTF-8"))
+# XXX env)
+# XXX "password")
+# XXX #:port fake-port))
+# XXX (test-equal (format #f "D password") output)
+# XXX (set! output "")
+# XXX (test-assert (pinentry-getpin pinentry "GETPIN"
+# XXX (lambda* (#:key (env '())
+# XXX visibility
+# XXX (prompt ">")
+# XXX message
+# XXX buttons
+# XXX only-match)
+# XXX (test-equal "Prompt" prompt)
+# XXX (test-equal (format #f "~a&#10;~a" error description)
+# XXX message)
+# XXX (test-assert (not visibility))
+# XXX (test-assert (not only-match))
+# XXX (test-assert (not buttons))
+# XXX (test-equal `(("DISPLAY" . ,display)
+# XXX ("LC_CTYPE" . "C")
+# XXX ("LC_MESSAGES" . "en_US.UTF-8"))
+# XXX env)
+# XXX "")
+# XXX #:port fake-port))
+# XXX (test-equal (format #f "ERR 83886179 Operation cancelled <rofi>\n") output)
+# XXX (set! output "")
+# XXX (test-assert (pinentry-getpin pinentry "GETPIN"
+# XXX (lambda* (#:key (env '())
+# XXX visibility
+# XXX (prompt ">")
+# XXX message
+# XXX buttons
+# XXX only-match)
+# XXX (test-equal "Prompt" prompt)
+# XXX (test-equal (format #f "~a&#10;~a" error description)
+# XXX message)
+# XXX (test-assert (not visibility))
+# XXX (test-assert (not only-match))
+# XXX (test-assert (not buttons))
+# XXX (test-equal `(("DISPLAY" . ,display)
+# XXX ("LC_CTYPE" . "C")
+# XXX ("LC_MESSAGES" . "en_US.UTF-8"))
+# XXX env)
+# XXX " ")
+# XXX #:port fake-port))
+# XXX (test-equal (format #f "ERR 83886179 Operation cancelled <rofi>\n") output)
+# XXX (test-assert (not (pinentry-getinfo pinentry " GETPIN")))
+# XXX (test-assert (not (pinentry-getinfo pinentry "Foo"))))
+# XXX
+# XXX (let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "en_US.UTF-8"))
+# XXX (description "This is a description")
+# XXX (error "Something went wrong")
+# XXX (display ":1"))
+# XXX (set-pinentry-desc! pinentry description)
+# XXX (set-pinentry-display! pinentry display)
+# XXX (test-assert (pinentry-confirm pinentry "CONFIRM"
+# XXX (lambda* (#:key (env '())
+# XXX visibility
+# XXX (prompt ">")
+# XXX message
+# XXX buttons
+# XXX only-match)
+# XXX (test-equal ">" prompt)
+# XXX (test-equal description message)
+# XXX (test-assert visibility)
+# XXX (test-assert only-match)
+# XXX (test-equal `("Ok" "Cancel") buttons)
+# XXX (test-equal `(("DISPLAY" . ,display)
+# XXX ("LC_CTYPE" . "C")
+# XXX ("LC_MESSAGES" . "en_US.UTF-8"))
+# XXX env)
+# XXX "Ok")))
+# XXX (test-assert (pinentry-ok pinentry))
+# XXX (set-pinentry-error! pinentry error)
+# XXX (let* ((output "")
+# XXX (fake-port (make-soft-port
+# XXX (vector
+# XXX (lambda (c) (set! output (string-append output c)))
+# XXX (lambda (s) (set! output (string-append output s)))
+# XXX (lambda () #t)
+# XXX #f
+# XXX (lambda () #t))
+# XXX "w")))
+# XXX (test-assert (pinentry-confirm
+# XXX pinentry
+# XXX "CONFIRM"
+# XXX (lambda* (#:key (env '())
+# XXX visibility
+# XXX (prompt ">")
+# XXX message
+# XXX buttons
+# XXX only-match)
+# XXX (test-equal ">" prompt)
+# XXX (test-equal (format #f "~a&#10;~a" error description)
+# XXX message)
+# XXX (test-assert visibility)
+# XXX (test-assert only-match)
+# XXX (test-equal `("Ok" "Cancel") buttons)
+# XXX (test-equal `(("DISPLAY" . ,display)
+# XXX ("LC_CTYPE" . "C")
+# XXX ("LC_MESSAGES" . "en_US.UTF-8"))
+# XXX env)
+# XXX "Cancel")
+# XXX #:port fake-port))
+# XXX (test-equal (format #f "ERR 277 Operation cancelled\n") output))
+# XXX (test-assert (not (pinentry-ok pinentry)))
+# XXX (test-assert (not (pinentry-getinfo pinentry " CONFIRM")))
+# XXX (test-assert (not (pinentry-getinfo pinentry "Foo"))))
+# XXX
+# XXX (let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "en_US.UTF-8"))
+# XXX (description "This is a description")
+# XXX (display ":1"))
+# XXX (set-pinentry-desc! pinentry description)
+# XXX (set-pinentry-display! pinentry display)
+# XXX (test-assert (pinentry-confirm pinentry "CONFIRM --one-button"
+# XXX (lambda* (#:key (env '())
+# XXX visibility
+# XXX (prompt ">")
+# XXX message
+# XXX buttons
+# XXX only-match)
+# XXX (test-equal ">" prompt)
+# XXX (test-equal description message)
+# XXX (test-assert visibility)
+# XXX (test-assert only-match)
+# XXX (test-equal `("Ok") buttons)
+# XXX (test-equal `(("DISPLAY" . ,display)
+# XXX ("LC_CTYPE" . "C")
+# XXX ("LC_MESSAGES" . "en_US.UTF-8"))
+# XXX env)
+# XXX "Ok")))
+# XXX (test-assert (pinentry-ok pinentry))
+# XXX (set-pinentry-ok! pinentry #f)
+# XXX (test-assert (pinentry-confirm pinentry "MESSAGE"
+# XXX (lambda* (#:key (env '())
+# XXX visibility
+# XXX (prompt ">")
+# XXX message
+# XXX buttons
+# XXX only-match)
+# XXX (test-equal ">" prompt)
+# XXX (test-equal description message)
+# XXX (test-assert visibility)
+# XXX (test-assert only-match)
+# XXX (test-equal `("Ok") buttons)
+# XXX (test-equal `(("DISPLAY" . ,display)
+# XXX ("LC_CTYPE" . "C")
+# XXX ("LC_MESSAGES" . "en_US.UTF-8"))
+# XXX env)
+# XXX "Ok")))
+# XXX (test-assert (pinentry-ok pinentry))
+# XXX (test-assert (not (pinentry-getinfo pinentry " CONFIRM --one-button")))
+# XXX (test-assert (not (pinentry-getinfo pinentry "MESSAGE --one-button")))
+# XXX (test-assert (not (pinentry-getinfo pinentry " MESSAGE")))
+# XXX (test-assert (not (pinentry-getinfo pinentry "Foo"))))
+# XXX
+# XXX (test-end "pinentry-rofi")
diff --git a/tests/pinentry-rofi.scm b/tests/pinentry-rofi.scm
deleted file mode 100755
index 977d1d5..0000000
--- a/tests/pinentry-rofi.scm
+++ /dev/null
@@ -1,459 +0,0 @@
-;; SPDX-FileCopyrightText: 2020-2023 Fredrik Salomonsson <plattfot@posteo.net>
-;;
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-(define-module (tests-pinentry-rofi)
- #:use-module (srfi srfi-64)
- #:use-module (ice-9 popen)
- #:use-module (ice-9 textual-ports)
- #:use-module (pinentry-rofi))
-
-(test-begin "pinentry-rofi")
-
-;; (test-begin "pinentry")
-(let ((pinentry (make-pinentry #t "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
- (test-assert (pinentry? pinentry))
- (test-assert (pinentry-ok pinentry))
- (test-equal "Prompt" (pinentry-prompt pinentry))
- (test-equal "Ok" (pinentry-ok-button pinentry))
- (test-equal "Cancel" (pinentry-cancel-button pinentry))
- (test-equal ":1" (pinentry-display pinentry))
- (test-equal "test.log" (pinentry-logfile pinentry))
- (test-assert (not (pinentry-notok-button pinentry)))
- (test-assert (not (pinentry-visibility pinentry)))
- (test-assert (not (pinentry-error pinentry))))
-
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
- (test-assert (not (pinentry-ok pinentry))))
-
-;; (test-end "pinentry")
-
-;; (test-begin "utils")
-
-(test-equal "Ok" (remove-underline "_Ok"))
-(test-equal " Ok" (remove-underline " _Ok"))
-(test-equal "foo_bar" (remove-underline "foo_bar"))
-(test-equal "foo__bar" (remove-underline "foo__bar"))
-(test-equal " __Ok" (remove-underline " __Ok"))
-(test-equal "__Ok" (remove-underline "__Ok"))
-(test-equal "Ok%0ACancel" (remove-underline "_Ok%0A_Cancel"))
-(test-equal "Ok&#10;Cancel" (remove-underline "_Ok&#10;_Cancel"))
-
-(test-equal "_Ok" (escape-underscore "_Ok"))
-(test-equal " _Ok" (escape-underscore " _Ok"))
-(test-equal "foo_bar" (escape-underscore "foo_bar"))
-(test-equal "foo__bar" (escape-underscore "foo__bar"))
-(test-equal " _Ok" (escape-underscore " __Ok"))
-(test-equal "_Ok" (escape-underscore "__Ok"))
-(test-equal "_Ok%0A_Cancel" (escape-underscore "__Ok%0A__Cancel"))
-(test-equal "_Ok&#10;_Cancel" (escape-underscore "__Ok&#10;__Cancel"))
-
-(test-assert (string-empty? ""))
-(test-assert (not (string-empty? "foo")))
-;; (test-end "utils")
-
-(test-equal "This is one line\nThis is another%OA"
- (hex->char "%54his is one line%0AThis is another%OA"))
-
-;; (test-begin "html")
-(test-equal "%54his is one line&#10;This is another%OA"
- (html-newline "%54his is one line%0AThis is another%OA"))
-(test-equal "%54his is one line\nThis is another%OA"
- (html-newline "%54his is one line\nThis is another%OA"))
-
-(test-equal "<u>O</u>k" (html-underline "_Ok"))
-(test-equal " <u>O</u>k" (html-underline " _Ok"))
-(test-equal "foo_bar" (html-underline "foo_bar"))
-(test-equal "foo__bar" (html-underline "foo__bar"))
-(test-equal " __Ok" (html-underline " __Ok"))
-(test-equal "__Ok" (html-underline "__Ok"))
-(test-equal "<u>O</u>k%0A<u>C</u>ancel" (html-underline "_Ok%0A_Cancel"))
-(test-equal "<u>O</u>k&#10;<u>C</u>ancel" (html-underline "_Ok&#10;_Cancel"))
-
-;; (test-end "html")
-
-(test-equal "<u>T</u>his is one line&#10;<u>T</u>his is another%OA"
- (pango-markup "_%54his is one line%0A_This is another%OA"))
-
-(test-equal "Ok\nCancel"
- (input-string "_Ok\nCancel"))
-
-(test-equal "Ok\n_Cancel"
- (input-string "_Ok\n__Cancel"))
-
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
- (pinentry-set set-pinentry-notok-button! pinentry "Not ok")
- (test-equal "Not ok" (pinentry-notok-button pinentry))
- (test-assert (pinentry-ok pinentry)))
-
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
- (test-error #t (pinentry-set pinentry-notok-button pinentry "Not ok")))
-
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
- (test-assert (pinentry-option pinentry "OPTION default-ok=Okay"))
- (test-equal "Okay" (pinentry-ok-button pinentry))
- (test-equal "Cancel" (pinentry-cancel-button pinentry))
- (test-equal "Prompt" (pinentry-prompt pinentry))
- (test-equal "C" (pinentry-lc-ctype pinentry))
- (test-equal "C" (pinentry-lc-messages pinentry))
- (test-assert (pinentry-ok pinentry)))
-
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
- (test-assert (pinentry-option pinentry "OPTION default-cancel=No"))
- (test-equal "Ok" (pinentry-ok-button pinentry))
- (test-equal "No" (pinentry-cancel-button pinentry))
- (test-equal "Prompt" (pinentry-prompt pinentry))
- (test-equal "C" (pinentry-lc-ctype pinentry))
- (test-equal "C" (pinentry-lc-messages pinentry))
- (test-assert (pinentry-ok pinentry)))
-
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
- (test-assert (pinentry-option pinentry "OPTION default-prompt=Password:"))
- (test-equal "Ok" (pinentry-ok-button pinentry))
- (test-equal "Cancel" (pinentry-cancel-button pinentry))
- (test-equal "Password:" (pinentry-prompt pinentry))
- (test-equal "C" (pinentry-lc-ctype pinentry))
- (test-equal "C" (pinentry-lc-messages pinentry))
- (test-assert (pinentry-ok pinentry)))
-
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
- (test-assert (pinentry-option pinentry "OPTION lc-ctype=en_US.UTF-8"))
- (test-equal "Ok" (pinentry-ok-button pinentry))
- (test-equal "Cancel" (pinentry-cancel-button pinentry))
- (test-equal "Prompt" (pinentry-prompt pinentry))
- (test-equal "en_US.UTF-8" (pinentry-lc-ctype pinentry))
- (test-equal "C" (pinentry-lc-messages pinentry))
- (test-assert (pinentry-ok pinentry)))
-
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
- (test-assert (pinentry-option pinentry "OPTION lc-messages=en_US.UTF-8"))
- (test-equal "Ok" (pinentry-ok-button pinentry))
- (test-equal "Cancel" (pinentry-cancel-button pinentry))
- (test-equal "Prompt" (pinentry-prompt pinentry))
- (test-equal "C" (pinentry-lc-ctype pinentry))
- (test-equal "en_US.UTF-8" (pinentry-lc-messages pinentry))
- (test-assert (pinentry-ok pinentry)))
-
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
- (test-assert (pinentry-option pinentry "OPTION foo bar")))
-
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
- (test-assert (not (pinentry-option pinentry " OPTION foo bar")))
- (test-assert (not (pinentry-option pinentry "OPTION")))
- (test-assert (not (pinentry-option pinentry "Foo"))))
-
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C"))
- (output "")
- (fake-port (make-soft-port
- (vector
- (lambda (c) (set! output (string-append output c)))
- (lambda (s) (set! output (string-append output s)))
- (lambda () #t)
- #f
- (lambda () #t))
- "w")))
- (test-assert (pinentry-getinfo pinentry "GETINFO pid" #:port fake-port))
- (test-equal (format #f "D ~a\n" (getpid)) output)
- (test-assert (pinentry-getinfo pinentry "GETINFO foo bar"))
- (test-assert (not (pinentry-getinfo pinentry " GETINFO foo bar")))
- (test-assert (not (pinentry-getinfo pinentry "GETINFO")))
- (test-assert (not (pinentry-getinfo pinentry "Foo"))))
-
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
- (test-assert (pinentry-setkeyinfo pinentry "SETKEYINFO Foo"))
- (test-assert (pinentry-ok pinentry))
- (test-assert (not (pinentry-setkeyinfo pinentry " SETKEYINFO foo bar")))
- (test-assert (not (pinentry-setkeyinfo pinentry "SETKEYINFO")))
- (test-assert (not (pinentry-setkeyinfo pinentry "Foo"))))
-
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
- (test-assert (pinentry-setok pinentry "SETOK Foo"))
- (test-equal "Foo" (pinentry-ok-button pinentry))
- (test-assert (pinentry-ok pinentry))
- (test-assert (pinentry-setok pinentry "SETOK _Ok okay"))
- (test-equal "Ok okay" (pinentry-ok-button pinentry))
- (test-assert (not (pinentry-setok pinentry " SETOK foo bar")))
- (test-equal "Ok okay" (pinentry-ok-button pinentry))
- (test-assert (not (pinentry-setok pinentry "SETOK")))
- (test-equal "Ok okay" (pinentry-ok-button pinentry))
- (test-assert (not (pinentry-setok pinentry "Foo")))
- (test-equal "Ok okay" (pinentry-ok-button pinentry)))
-
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
- (test-assert (pinentry-setnotok pinentry "SETNOTOK Foo"))
- (test-equal "Foo" (pinentry-notok-button pinentry))
- (test-assert (pinentry-ok pinentry))
- (test-assert (pinentry-setnotok pinentry "SETNOTOK Not _Ok"))
- (test-equal "Not Ok" (pinentry-notok-button pinentry))
- (test-assert (not (pinentry-setnotok pinentry " SETNOTOK foo bar")))
- (test-equal "Not Ok" (pinentry-notok-button pinentry))
- (test-assert (not (pinentry-setnotok pinentry "SETNOTOK")))
- (test-equal "Not Ok" (pinentry-notok-button pinentry))
- (test-assert (not (pinentry-setnotok pinentry "Foo")))
- (test-equal "Not Ok" (pinentry-notok-button pinentry)))
-
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
- (test-assert (pinentry-setcancel pinentry "SETCANCEL Foo"))
- (test-equal "Foo" (pinentry-cancel-button pinentry))
- (test-assert (pinentry-ok pinentry))
- (test-assert (pinentry-setcancel pinentry "SETCANCEL _Abort"))
- (test-equal "Abort" (pinentry-cancel-button pinentry))
- (test-assert (not (pinentry-setcancel pinentry " SETCANCEL foo bar")))
- (test-equal "Abort" (pinentry-cancel-button pinentry))
- (test-assert (not (pinentry-setcancel pinentry "SETCANCEL")))
- (test-equal "Abort" (pinentry-cancel-button pinentry))
- (test-assert (not (pinentry-setcancel pinentry "Foo")))
- (test-equal "Abort" (pinentry-cancel-button pinentry)))
-
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Desc" ":1" "test.log" "C" "C")))
- (test-assert (pinentry-setdesc pinentry "SETDESC Foo"))
- (test-equal "Foo" (pinentry-desc pinentry))
- (test-assert (pinentry-ok pinentry))
- (test-assert (pinentry-setdesc pinentry "SETDESC _%54his is a description%0A_On two lines"))
- (test-equal "<u>T</u>his is a description&#10;<u>O</u>n two lines" (pinentry-desc pinentry))
- (test-assert (not (pinentry-setdesc pinentry " SETDESC foo bar")))
- (test-equal "<u>T</u>his is a description&#10;<u>O</u>n two lines" (pinentry-desc pinentry))
- (test-assert (not (pinentry-setdesc pinentry "SETDESC")))
- (test-equal "<u>T</u>his is a description&#10;<u>O</u>n two lines" (pinentry-desc pinentry))
- (test-assert (not (pinentry-setdesc pinentry "Foo")))
- (test-equal "<u>T</u>his is a description&#10;<u>O</u>n two lines" (pinentry-desc pinentry)))
-
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Error" ":1" "test.log" "C" "C")))
- (test-assert (pinentry-seterror pinentry "SETERROR Foo"))
- (test-equal "Foo" (pinentry-error pinentry))
- (test-assert (pinentry-ok pinentry))
- (test-assert (pinentry-seterror pinentry "SETERROR _%54his is an error%0A_On two lines"))
- (test-equal "<u>T</u>his is an error&#10;<u>O</u>n two lines" (pinentry-error pinentry))
- (test-assert (not (pinentry-seterror pinentry " SETERROR foo bar")))
- (test-equal "<u>T</u>his is an error&#10;<u>O</u>n two lines" (pinentry-error pinentry))
- (test-assert (not (pinentry-seterror pinentry "SETERROR")))
- (test-equal "<u>T</u>his is an error&#10;<u>O</u>n two lines" (pinentry-error pinentry))
- (test-assert (not (pinentry-seterror pinentry "Foo")))
- (test-equal "<u>T</u>his is an error&#10;<u>O</u>n two lines" (pinentry-error pinentry)))
-
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Prompt" ":1" "test.log" "C" "C")))
- (test-assert (pinentry-setprompt pinentry "SETPROMPT Foo"))
- (test-equal "Foo" (pinentry-prompt pinentry))
- (test-assert (pinentry-ok pinentry))
- (test-assert (pinentry-setprompt pinentry "SETPROMPT _%54his is a prompt%0A_On two lines"))
- (test-equal "<u>T</u>his is a prompt&#10;<u>O</u>n two lines" (pinentry-prompt pinentry))
- (test-assert (not (pinentry-setprompt pinentry " SETPROMPT foo bar")))
- (test-equal "<u>T</u>his is a prompt&#10;<u>O</u>n two lines" (pinentry-prompt pinentry))
- (test-assert (not (pinentry-setprompt pinentry "SETPROMPT")))
- (test-equal "<u>T</u>his is a prompt&#10;<u>O</u>n two lines" (pinentry-prompt pinentry))
- (test-assert (not (pinentry-setprompt pinentry "Foo")))
- (test-equal "<u>T</u>his is a prompt&#10;<u>O</u>n two lines" (pinentry-prompt pinentry)))
-
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Prompt" ":1" "test.log" "C" "C")))
- (test-error "(quit #t)" (pinentry-bye pinentry "BYE"))
- (test-assert (not (pinentry-bye pinentry "Hej då"))))
-
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "en_US.UTF-8"))
- (output "")
- (fake-port (make-soft-port
- (vector
- (lambda (c) (set! output (string-append output c)))
- (lambda (s) (set! output (string-append output s)))
- (lambda () #t)
- #f
- (lambda () #t))
- "w"))
- (description "This is a description")
- (error "Something went wrong")
- (display ":1"))
- (set-pinentry-desc! pinentry description)
- (set-pinentry-display! pinentry display)
- (test-assert (pinentry-getpin pinentry "GETPIN"
- (lambda* (#:key (env '())
- visibility
- (prompt ">")
- message
- buttons
- only-match)
- (test-equal "Prompt" prompt)
- (test-equal description message)
- (test-assert (not visibility))
- (test-assert (not only-match))
- (test-assert (not buttons))
- (test-equal `(("DISPLAY" . ,display)
- ("LC_CTYPE" . "C")
- ("LC_MESSAGES" . "en_US.UTF-8"))
- env)
- "password")
- #:port fake-port))
- (test-equal (format #f "D password") output)
- (set-pinentry-error! pinentry error)
- (set! output "")
- (test-assert (pinentry-getpin pinentry "GETPIN"
- (lambda* (#:key (env '())
- visibility
- (prompt ">")
- message
- buttons
- only-match)
- (test-equal "Prompt" prompt)
- (test-equal (format #f "~a&#10;~a" error description)
- message)
- (test-assert (not visibility))
- (test-assert (not only-match))
- (test-assert (not buttons))
- (test-equal `(("DISPLAY" . ,display)
- ("LC_CTYPE" . "C")
- ("LC_MESSAGES" . "en_US.UTF-8"))
- env)
- "password")
- #:port fake-port))
- (test-equal (format #f "D password") output)
- (set! output "")
- (test-assert (pinentry-getpin pinentry "GETPIN"
- (lambda* (#:key (env '())
- visibility
- (prompt ">")
- message
- buttons
- only-match)
- (test-equal "Prompt" prompt)
- (test-equal (format #f "~a&#10;~a" error description)
- message)
- (test-assert (not visibility))
- (test-assert (not only-match))
- (test-assert (not buttons))
- (test-equal `(("DISPLAY" . ,display)
- ("LC_CTYPE" . "C")
- ("LC_MESSAGES" . "en_US.UTF-8"))
- env)
- "")
- #:port fake-port))
- (test-equal (format #f "ERR 83886179 Operation cancelled <rofi>\n") output)
- (set! output "")
- (test-assert (pinentry-getpin pinentry "GETPIN"
- (lambda* (#:key (env '())
- visibility
- (prompt ">")
- message
- buttons
- only-match)
- (test-equal "Prompt" prompt)
- (test-equal (format #f "~a&#10;~a" error description)
- message)
- (test-assert (not visibility))
- (test-assert (not only-match))
- (test-assert (not buttons))
- (test-equal `(("DISPLAY" . ,display)
- ("LC_CTYPE" . "C")
- ("LC_MESSAGES" . "en_US.UTF-8"))
- env)
- " ")
- #:port fake-port))
- (test-equal (format #f "ERR 83886179 Operation cancelled <rofi>\n") output)
- (test-assert (not (pinentry-getinfo pinentry " GETPIN")))
- (test-assert (not (pinentry-getinfo pinentry "Foo"))))
-
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "en_US.UTF-8"))
- (description "This is a description")
- (error "Something went wrong")
- (display ":1"))
- (set-pinentry-desc! pinentry description)
- (set-pinentry-display! pinentry display)
- (test-assert (pinentry-confirm pinentry "CONFIRM"
- (lambda* (#:key (env '())
- visibility
- (prompt ">")
- message
- buttons
- only-match)
- (test-equal ">" prompt)
- (test-equal description message)
- (test-assert visibility)
- (test-assert only-match)
- (test-equal `("Ok" "Cancel") buttons)
- (test-equal `(("DISPLAY" . ,display)
- ("LC_CTYPE" . "C")
- ("LC_MESSAGES" . "en_US.UTF-8"))
- env)
- "Ok")))
- (test-assert (pinentry-ok pinentry))
- (set-pinentry-error! pinentry error)
- (let* ((output "")
- (fake-port (make-soft-port
- (vector
- (lambda (c) (set! output (string-append output c)))
- (lambda (s) (set! output (string-append output s)))
- (lambda () #t)
- #f
- (lambda () #t))
- "w")))
- (test-assert (pinentry-confirm
- pinentry
- "CONFIRM"
- (lambda* (#:key (env '())
- visibility
- (prompt ">")
- message
- buttons
- only-match)
- (test-equal ">" prompt)
- (test-equal (format #f "~a&#10;~a" error description)
- message)
- (test-assert visibility)
- (test-assert only-match)
- (test-equal `("Ok" "Cancel") buttons)
- (test-equal `(("DISPLAY" . ,display)
- ("LC_CTYPE" . "C")
- ("LC_MESSAGES" . "en_US.UTF-8"))
- env)
- "Cancel")
- #:port fake-port))
- (test-equal (format #f "ERR 277 Operation cancelled\n") output))
- (test-assert (not (pinentry-ok pinentry)))
- (test-assert (not (pinentry-getinfo pinentry " CONFIRM")))
- (test-assert (not (pinentry-getinfo pinentry "Foo"))))
-
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "en_US.UTF-8"))
- (description "This is a description")
- (display ":1"))
- (set-pinentry-desc! pinentry description)
- (set-pinentry-display! pinentry display)
- (test-assert (pinentry-confirm pinentry "CONFIRM --one-button"
- (lambda* (#:key (env '())
- visibility
- (prompt ">")
- message
- buttons
- only-match)
- (test-equal ">" prompt)
- (test-equal description message)
- (test-assert visibility)
- (test-assert only-match)
- (test-equal `("Ok") buttons)
- (test-equal `(("DISPLAY" . ,display)
- ("LC_CTYPE" . "C")
- ("LC_MESSAGES" . "en_US.UTF-8"))
- env)
- "Ok")))
- (test-assert (pinentry-ok pinentry))
- (set-pinentry-ok! pinentry #f)
- (test-assert (pinentry-confirm pinentry "MESSAGE"
- (lambda* (#:key (env '())
- visibility
- (prompt ">")
- message
- buttons
- only-match)
- (test-equal ">" prompt)
- (test-equal description message)
- (test-assert visibility)
- (test-assert only-match)
- (test-equal `("Ok") buttons)
- (test-equal `(("DISPLAY" . ,display)
- ("LC_CTYPE" . "C")
- ("LC_MESSAGES" . "en_US.UTF-8"))
- env)
- "Ok")))
- (test-assert (pinentry-ok pinentry))
- (test-assert (not (pinentry-getinfo pinentry " CONFIRM --one-button")))
- (test-assert (not (pinentry-getinfo pinentry "MESSAGE --one-button")))
- (test-assert (not (pinentry-getinfo pinentry " MESSAGE")))
- (test-assert (not (pinentry-getinfo pinentry "Foo"))))
-
-(test-end "pinentry-rofi")