From d7bc3470b76268fb121868960aab04c88a4d712f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 2 Jun 2015 21:50:07 +0200
Subject: gnu-maintenance: latest-release: Honor releases that are not in
 subdirs.

Reported by Mark H Weaver.

* guix/gnu-maintenance.scm (latest-release): Add 'result' parameter to
  'loop'.  When entering a sub-directory, use the current directory's latest
  release as 'result'.  This fixes the code for 'gnu-pw-mgr' and 'sharutils'.
---
 guix/gnu-maintenance.scm | 61 +++++++++++++++++++++++++++---------------------
 1 file changed, 34 insertions(+), 27 deletions(-)

(limited to 'guix/gnu-maintenance.scm')

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 5cdda28bc7..8d47cee487 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -357,7 +357,8 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
   (let-values (((server directory) (ftp-server/directory project)))
     (define conn (ftp-open server))
 
-    (let loop ((directory directory))
+    (let loop ((directory directory)
+               (result    #f))
       (let* ((entries (ftp-list conn directory))
 
              ;; Filter out sub-directories that do not contain digits---e.g.,
@@ -369,32 +370,38 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
                                    (((? contains-digit? dir) 'directory . _)
                                     dir)
                                    (_ #f))
-                                  entries)))
-        (match subdirs
-          (()
-           ;; No sub-directories, so assume that tarballs are here.
-           (let ((releases (filter-map (match-lambda
-                                        ((file 'file . _)
-                                         (and (release-file? project file)
-                                              (gnu-release
-                                               (package project)
-                                               (version
-                                                (tarball->version file))
-                                               (directory directory)
-                                               (files (list file)))))
-                                        (_ #f))
-                                       entries)))
-             (ftp-close conn)
-             (reduce latest-release #f (coalesce-releases releases))))
-          ((subdirs ...)
-           ;; Assume that SUBDIRS correspond to versions, and jump into the
-           ;; one with the highest version number.
-           (let ((target (reduce latest #f subdirs)))
-             (if target
-                 (loop (string-append directory "/" target))
-                 (begin
-                   (ftp-close conn)
-                   #f)))))))))
+                                  entries))
+
+             ;; Whether or not SUBDIRS is empty, compute the latest releases
+             ;; for the current directory.  This is necessary for packages
+             ;; such as 'sharutils' that have a sub-directory that contains
+             ;; only an older release.
+             (releases (filter-map (match-lambda
+                                     ((file 'file . _)
+                                      (and (release-file? project file)
+                                           (gnu-release
+                                            (package project)
+                                            (version
+                                             (tarball->version file))
+                                            (directory directory)
+                                            (files (list file)))))
+                                     (_ #f))
+                                   entries)))
+
+        ;; Assume that SUBDIRS correspond to versions, and jump into the
+        ;; one with the highest version number.
+        (let* ((release  (reduce latest-release #f
+                                 (coalesce-releases releases)))
+               (result   (if (and result release)
+                             (latest-release release result)
+                             (or release result)))
+               (target   (reduce latest #f subdirs)))
+          (if target
+              (loop (string-append directory "/" target)
+                    result)
+              (begin
+                (ftp-close conn)
+                result)))))))
 
 (define (gnu-release-archive-types release)
   "Return the available types of archives for RELEASE---a list of strings such
-- 
cgit v1.2.3