[bug#55845] [PATCH 0/1] Improve pager selection logic when less is not installed

[Ludovic Courtès]

Hi,

Taiju HIGASHI <higashi@taiju.info> skribis:

>>From bf557600c549e22a06ccfb288b89b1a0736b0500 Mon Sep 17 00:00:00 2001
> From: Taiju HIGASHI <higashi@taiju.info>
> Date: Wed, 8 Jun 2022 18:50:28 +0900
> Subject: [PATCH v4] ui: Improve pager selection logic when less is not
>  installed.
>
> * guix/ui.scm (find-available-pager): New procedure. Return a available pager.
>   (call-with-paginated-output-port): Change to use find-available-pager to
>   select pager.
> * guix/utils.scm (call-with-environment-variables): Allow clearing of
> specified environment variables.
> * tests/ui.scm: Add tests for find-available-pager.

Applied with the cosmetic changes below, mostly aiming to visually
simplify the code and make it consistent with the rest.

It’s great that you went to great lengths to implement tests for this,
as Maxime had suggested.  To me, the complexity of a test must be
justified by its “bug-finding performance”; in this particular case, I
think we’re borderline: the tests are a little bit complex and unlikely
to find new bugs.

Thanks for all the work and for your feedback on your experience
programming with Guile!

Ludo’.

diff --git a/guix/ui.scm b/guix/ui.scm
index 93707a7a4b..a7acd41440 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -1674,15 +1674,13 @@ (define* (pager-wrapped-port #:optional (port 
(current-output-port)))
      #f)))
 
 (define (find-available-pager)
-  "Returns the program name or path of an available pager.
-If neither less nor more is installed, return an empty string so that
-call-with-paginated-output-port will not call pager."
+  "Return the program name of an available pager or the empty string if none is
+available."
   (or (getenv "GUIX_PAGER")
       (getenv "PAGER")
       (which "less")
       (which "more")
-      "" ;; Returns an empty string so that call-with-paginated-output-port 
does not call pager.
-      ))
+      ""))
 
 (define* (call-with-paginated-output-port proc
                                           #:key (less-options "FrX"))
diff --git a/tests/ui.scm b/tests/ui.scm
index ff83e66a7e..6a25a204ca 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -294,13 +294,12 @@ (define guile-2.0.9
          (>0 (package-relevance libb2
                                 (map rx '("crypto" "library")))))))
 
-(define make-dummy-file
-  (compose
-   close-port
-   open-output-file
-   (cut in-vicinity <> <>)))
+(define (make-empty-file directory file)
+  ;; Create FILE in DIRECTORY.
+  (close-port (open-output-file (in-vicinity directory file))))
 
 (define (assert-equals-find-available-pager expected)
+  ;; Use 'with-paginated-output-port' and return true if it invoked EXPECTED.
   (define used-command "")
   (mock ((ice-9 popen) open-pipe*
          (lambda (mode command . args)
@@ -314,56 +313,51 @@ (define used-command "")
                     (string=? expected used-command)))))
 
 
-(test-assert "find-available-pager, All environment variables are specified 
and both less and more are installed"
+(test-assert "find-available-pager, GUIX_PAGER takes precedence"
   (call-with-temporary-directory
    (lambda (dir)
-     (with-environment-variables
-         `(("PATH" ,dir)
-           ("GUIX_PAGER" "guix-pager")
-           ("PAGER" "pager"))
-       (make-dummy-file dir "less")
-       (make-dummy-file dir "more")
+     (with-environment-variables `(("PATH" ,dir)
+                                   ("GUIX_PAGER" "guix-pager")
+                                   ("PAGER" "pager"))
+       (make-empty-file dir "less")
+       (make-empty-file dir "more")
        (assert-equals-find-available-pager "guix-pager")))))
 
-(test-assert "find-available-pager, GUIX_PAGER is not specified"
+(test-assert "find-available-pager, PAGER takes precedence"
   (call-with-temporary-directory
    (lambda (dir)
-     (with-environment-variables
-         `(("PATH" ,dir)
-           ("GUIX_PAGER" #false)
-           ("PAGER" "pager"))
-       (make-dummy-file dir "less")
-       (make-dummy-file dir "more")
+     (with-environment-variables `(("PATH" ,dir)
+                                   ("GUIX_PAGER" #false)
+                                   ("PAGER" "pager"))
+       (make-empty-file dir "less")
+       (make-empty-file dir "more")
        (assert-equals-find-available-pager "pager")))))
 
-(test-assert "find-available-pager, All environment variables are not 
specified and both less and more are installed"
+(test-assert "find-available-pager, 'less' takes precedence"
   (call-with-temporary-directory
    (lambda (dir)
-     (with-environment-variables
-         `(("PATH" ,dir)
-           ("GUIX_PAGER" #false)
-           ("PAGER" #false))
-       (make-dummy-file dir "less")
-       (make-dummy-file dir "more")
+     (with-environment-variables `(("PATH" ,dir)
+                                   ("GUIX_PAGER" #false)
+                                   ("PAGER" #false))
+       (make-empty-file dir "less")
+       (make-empty-file dir "more")
        (assert-equals-find-available-pager (in-vicinity dir "less"))))))
 
-(test-assert "find-available-pager, All environment variables are not 
specified and more is installed"
+(test-assert "find-available-pager, 'more' takes precedence"
   (call-with-temporary-directory
    (lambda (dir)
-     (with-environment-variables
-         `(("PATH" ,dir)
-           ("GUIX_PAGER" #false)
-           ("PAGER" #false))
-       (make-dummy-file dir "more")
+     (with-environment-variables `(("PATH" ,dir)
+                                   ("GUIX_PAGER" #false)
+                                   ("PAGER" #false))
+       (make-empty-file dir "more")
        (assert-equals-find-available-pager (in-vicinity dir "more"))))))
 
-(test-assert "find-available-pager, All environment variables are not 
specified and both less and more are not installed"
+(test-assert "find-available-pager, no pager"
   (call-with-temporary-directory
    (lambda (dir)
-     (with-environment-variables
-         `(("PATH" ,dir)
-           ("GUIX_PAGER" #false)
-           ("PAGER" #false))
+     (with-environment-variables `(("PATH" ,dir)
+                                   ("GUIX_PAGER" #false)
+                                   ("PAGER" #false))
        (assert-equals-find-available-pager "")))))
 
 (test-end "ui")