From 30c09142e537646801f2ddcd3a1ce4bebcb9642c Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sat, 16 Jan 2016 16:30:41 +0100
Subject: [PATCH 4/4] Do not reinstall satisfied deps in deploy mode.

This fixes #1106
---
 NEWS                |  3 +++
 chicken-install.scm | 25 +++++++++++--------------
 2 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/NEWS b/NEWS
index 63728c6..6353d45 100644
--- a/NEWS
+++ b/NEWS
@@ -61,6 +61,9 @@
   - Increased the "binary compatibility version" to 8.
 
 - Tools
+  - "chicken-install"
+    - When installing eggs in deploy mode, already satisfied
+      dependencies aren't reinstalled every time (#1106).
   - "chicken-uninstall"
     - A -prefix option was added, matching chicken-install's -prefix.
   - "chicken-status"
diff --git a/chicken-install.scm b/chicken-install.scm
index bc23c9d..ad04edd 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -233,12 +233,9 @@
 
   (define (check-dependency dep)
     (cond ((or (symbol? dep) (string? dep))
-	   (values
-	    (if *deploy*
-		(->string dep)
-		(and (not (ext-version dep))
-		     (->string dep)))
-	    #f))
+	   (values (and (not (ext-version dep))
+			(->string dep))
+		   #f))
 	  ((and (list? dep) (eq? 'or (car dep)))
 	   (let scan ((ordeps (cdr dep)) (bestm #f) (bestu #f))
 	     (if (null? ordeps)
@@ -260,10 +257,8 @@
 	  ((and (list? dep) (= 2 (length dep))
 		(or (string? (car dep)) (symbol? (car dep))))
 	   (let ((v (ext-version (car dep))))
-	     (cond ((or *deploy* (not v))
-		    (values
-		     (->string (car dep))
-		     #f))
+	     (cond ((not v)
+		    (values (->string (car dep)) #f))
 		   ((not (version>=? v (->string (cadr dep))))
 		    (cond ((string=? "chicken" (->string (car dep)))
 			   (if *force*
@@ -850,10 +845,12 @@ EOF
       (setup-proxy (get-environment-variable "http_proxy"))
       (let loop ((args args) (eggs '()))
         (cond ((null? args)
-               (cond ((and *deploy* (not *prefix*))
-		      (error 
-		       "`-deploy' only makes sense in combination with `-prefix DIRECTORY`"))
-		     (update (update-db))
+	       (when *deploy*
+		 (unless *prefix*
+		   (error 
+		    "`-deploy' only makes sense in combination with `-prefix DIRECTORY`"))
+		 (repository-path *prefix*))
+               (cond (update (update-db))
 		     (scan (scan-directory scan))
                      (else
 		      (let ((defaults (load-defaults)))
-- 
2.1.4