guix-patches
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[bug#27550] [PATCH 2/2] utils: Remove useless procedures.


From: Mathieu Othacehe
Subject: [bug#27550] [PATCH 2/2] utils: Remove useless procedures.
Date: Sat, 1 Jul 2017 17:02:51 +0200

* src/cuirass/utils.scm (mkdir-p, make-user-module,
  call-with-temporary-directory, with-directory-excursion): Remove because
  already defined in guix.
* tests/utils (with-directory-excursion): Remove associated test.
* src/cuirass/base.scm: Use (guix build utils) to provide procedure removed
  from (cuirass utils).
* bin/evaluate.in: Ditto.
* bin/cuirass.in: Use "make-user-module" provided by (guix ui).
---
 bin/cuirass.in        |  4 +--
 bin/evaluate.in       |  2 +-
 src/cuirass/base.scm  |  2 +-
 src/cuirass/utils.scm | 69 +--------------------------------------------------
 tests/utils.scm       | 15 -----------
 5 files changed, 5 insertions(+), 87 deletions(-)

diff --git a/bin/cuirass.in b/bin/cuirass.in
index 7df5ddb..27efaac 100644
--- a/bin/cuirass.in
+++ b/bin/cuirass.in
@@ -26,7 +26,7 @@ exec ${GUILE:address@hidden@} --no-auto-compile -e main -s 
"$0" "$@"
 
 (use-modules (cuirass)
              (cuirass ui)
-             (cuirass utils)
+             (guix ui)
              (ice-9 getopt-long))
 
 (define (show-help)
@@ -90,7 +90,7 @@ exec ${GUILE:address@hidden@} --no-auto-compile -e main -s 
"$0" "$@"
             (and specfile
                  (let ((new-specs (save-module-excursion
                                    (λ ()
-                                     (set-current-module (make-user-module))
+                                     (set-current-module (make-user-module 
'()))
                                      (primitive-load specfile)))))
                    (for-each (λ (spec) (db-add-specification db spec))
                              new-specs)))
diff --git a/bin/evaluate.in b/bin/evaluate.in
index 8875238..09a785b 100644
--- a/bin/evaluate.in
+++ b/bin/evaluate.in
@@ -26,9 +26,9 @@ exec ${GUILE:address@hidden@} --no-auto-compile -e main -s 
"$0" "$@"
 ;;; along with Cuirass.  If not, see <http://www.gnu.org/licenses/>.
 
 (use-modules (cuirass)
-             (cuirass utils)
              (ice-9 match)
              (ice-9 pretty-print)
+             (guix build utils)
              (guix store))
 
 (define* (main #:optional (args (command-line)))
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index fc3cc1a..58f2be3 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -20,8 +20,8 @@
 
 (define-module (cuirass base)
   #:use-module (cuirass database)
-  #:use-module (cuirass utils)
   #:use-module (gnu packages)
+  #:use-module (guix build utils)
   #:use-module (guix derivations)
   #:use-module (guix store)
   #:use-module (ice-9 format)
diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm
index bcd5e12..dbe00a0 100644
--- a/src/cuirass/utils.scm
+++ b/src/cuirass/utils.scm
@@ -23,12 +23,8 @@
   #:use-module (srfi srfi-1)
   #:export (;; Procedures
             alist?
-            mkdir-p
-            make-user-module
-            call-with-temporary-directory
             ;; Macros.
-            λ*
-            with-directory-excursion))
+            λ*))
 
 (define-syntax-rule (λ* formals body ...)
   (lambda* formals body ...))
@@ -37,66 +33,3 @@
   "Return #t if OBJ is an alist."
   (and (list? obj)
        (every pair? obj)))
-
-(define mkdir-p
-  (let ((not-slash (char-set-complement (char-set #\/))))
-    (λ* (dir #:optional mode)
-      "Create directory DIR and all its ancestors."
-      (let ((absolute? (string-prefix? "/" dir)))
-        (let loop ((components (string-tokenize dir not-slash))
-                   (root       (if absolute? "" ".")))
-          (match components
-            ((head tail ...)
-             (let ((dir-name (string-append root "/" head)))
-               (catch 'system-error
-                 (λ ()
-                   (if mode
-                       (mkdir dir-name mode)
-                       (mkdir dir-name))
-                   (loop tail dir-name))
-                 (λ args
-                   ;; On GNU/Hurd we can get EROFS instead of EEXIST here.
-                   ;; Thus, if we get something other than EEXIST, check
-                   ;; whether DIR-NAME exists.  See
-                   ;; 
<https://lists.gnu.org/archive/html/guix-devel/2016-02/msg00049.html>.
-                   (if (or (= EEXIST (system-error-errno args))
-                           (let ((st (stat dir-name #f)))
-                             (and st (eq? 'directory (stat:type st)))))
-                       (loop tail dir-name)
-                       (apply throw args))))))
-            (() #t)))))))
-
-(define-syntax-rule (with-directory-excursion dir body ...)
-  "Run BODY with DIR as the process's current directory."
-  (let ((init (getcwd)))
-    (dynamic-wind
-      (λ () (chdir dir))
-      (λ () body ...)
-      (λ () (chdir init)))))
-
-(define* (make-user-module #:optional (modules '()))
-  "Return a new user module with the additional MODULES loaded."
-  ;; Module in which the machine description file is loaded.
-  (let ((module (make-fresh-user-module)))
-    (for-each (lambda (iface)
-                (module-use! module (resolve-interface iface)))
-              modules)
-    module))
-
-
-;;;
-;;; Temporary files.
-;;;
-
-(define (call-with-temporary-directory proc)
-  "Call PROC with a name of a temporary directory; close the directory and
-delete it when leaving the dynamic extent of this call."
-  (let* ((parent  (or (getenv "TMPDIR") "/tmp"))
-         (tmp-dir (string-append parent "/" (basename (tmpnam)))))
-    (mkdir-p tmp-dir)
-    (dynamic-wind
-      (const #t)
-      (lambda ()
-        (proc tmp-dir))
-      (lambda ()
-        (false-if-exception (rmdir tmp-dir))))))
diff --git a/tests/utils.scm b/tests/utils.scm
index 6a14355..d5298c5 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -35,19 +35,4 @@
        (not (alist? 'foo))
        (not (alist? #:bar))))
 
-(test-assert "with-directory-excursion"
-  (let ((old (getcwd))
-        (tmp (tmpnam)))
-    (dynamic-wind
-      (λ ()
-        (mkdir tmp))
-      (λ ()
-        (with-directory-excursion tmp
-          (dir-1 (getcwd)))
-        (dir-2 (getcwd))
-        (and (string=? (dir-1) tmp)
-             (string=? (dir-2) old)))
-      (λ ()
-        (rmdir tmp)))))
-
 (test-end)
-- 
2.13.1






reply via email to

[Prev in Thread] Current Thread [Next in Thread]