~ chicken-core (chicken-5) 70e091fdb198e03e62b819e647b7029b6d39cb95

commit 70e091fdb198e03e62b819e647b7029b6d39cb95
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Jan 6 08:35:25 2010 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Wed Jan 6 08:35:25 2010 +0100

    handle installation of deps in no-install mode; removed deprecated setup-install-flag and setup-verbose-flag

diff --git a/chicken-install.scm b/chicken-install.scm
index 79d55352..9d30369c 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -82,6 +82,7 @@
   (define *windows-shell* (foreign-value "C_WINDOWS_SHELL" bool))
   (define *proxy-host* #f)
   (define *proxy-port* #f)
+  (define *running-test* #f)
 
   (define-constant +module-db+ "modules.db")
   (define-constant +defaults-file+ "setup.defaults")
@@ -290,7 +291,7 @@
                       "- assuming it has no dependencies")) ] ) ) ) )
        *eggs+dirs+vers*) ) )
 
-  (define (make-install-command e+d+v)
+  (define (make-install-command e+d+v dep?)
     (conc
      *csi*
      " -bnq "
@@ -302,7 +303,7 @@
      (sprintf " -e \"(extension-name-and-version '(\\\"~a\\\" \\\"~a\\\"))\"" (car e+d+v) (caddr e+d+v))
      (if (sudo-install) " -e \"(sudo-install #t)\"" "")
      (if *keep* " -e \"(keep-intermediates #t)\"" "")
-     (if *no-install* " -e \"(setup-install-mode #f)\"" "")
+     (if (and *no-install* (not dep?)) " -e \"(setup-install-mode #f)\"" "")
      (if *host-extension* " -e \"(host-extension #t)\"" "")
      (if *prefix* (sprintf " -e \"(installation-prefix \\\"~a\\\")\"" *prefix*) "")
      #\space
@@ -311,26 +312,41 @@
   (define (install eggs)
     (retrieve eggs)
     (unless *retrieve-only*
-      (let ((dag (reverse (topological-sort *dependencies* string=?))))
+      (let* ((dag (reverse (topological-sort *dependencies* string=?)))
+	     (num (length dag))
+	     (depinstall-ok *force*))
 	(print "install order:")
 	(pp dag)
 	(for-each
-	 (lambda (e+d+v)
+	 (lambda (e+d+v i)
+	   (when (and (not depinstall-ok)
+		      (= i 1)
+		      (> num 1))
+	     (unless (yes-or-no?
+		      (string-append
+		       "You specified `-no-install', but this extension has dependencies"
+		       " that are required for building. Do you still want to install them?"))
+	       (print "aborting installation.")
+	       (cleanup)
+	       (exit 1)))
 	   (print "installing " (car e+d+v) #\: (caddr e+d+v) " ...")
 	   (print "changing current directory to " (cadr e+d+v))
 	   (parameterize ((current-directory (cadr e+d+v)))
-	     (let ([cmd (make-install-command e+d+v)])
+	     (let ([cmd (make-install-command e+d+v (< i num))])
 	       (print "  " cmd)
 	       ($system cmd))
 	     (when (and *run-tests*
 			(file-exists? "tests")
 			(directory? "tests")
 			(file-exists? "tests/run.scm") )
+	       (set! *running-test* #t)
 	       (current-directory "tests")
 	       (let ((cmd (sprintf "~a -s run.scm ~a" *csi* (car e+d+v))))
 		 (print "  " cmd)
-		 ($system cmd)))))
-	 (map (cut assoc <> *eggs+dirs+vers*) dag)))))
+		 ($system cmd))
+	       (set! *running-test* #f))))
+	 (map (cut assoc <> *eggs+dirs+vers*) dag)
+	 (iota num 1)))))
 
   (define (cleanup)
     (unless *keep*
@@ -540,7 +556,7 @@ EOF
 	(newline (current-error-port))
         (print-error-message ex (current-error-port))
         (cleanup)
-        (exit 1))
+        (exit (if *running-test* 2 1)))
     (main (command-line-arguments))
     (cleanup))
 
diff --git a/setup-api.scm b/setup-api.scm
index e80e5e60..abb53ac4 100644
--- a/setup-api.scm
+++ b/setup-api.scm
@@ -44,7 +44,6 @@
      host-extension
      install-extension install-program install-script
      setup-verbose-mode setup-install-mode
-     setup-verbose-flag setup-install-flag			; DEPRECATED
      installation-prefix chicken-prefix 
      find-library find-header 
      program-path remove-file* 
@@ -116,8 +115,6 @@
 (define setup-root-directory      (make-parameter *base-directory*))
 (define setup-verbose-mode        (make-parameter #f))
 (define setup-install-mode        (make-parameter #t))
-(define setup-verbose-flag setup-verbose-mode) ; DEPRECATED
-(define setup-install-flag setup-install-mode) ; DEPRECATED
 (define program-path              (make-parameter *chicken-bin-path*))
 (define keep-intermediates (make-parameter #f))
 
@@ -174,7 +171,7 @@
         ((car args)     (sudo-install-setup))
         (else           (user-install-setup)) ) )
 
-(define abort-setup (make-parameter exit))
+(define abort-setup (make-parameter (cut exit 1)))
 
 (define (yes-or-no? str #!key default (abort (abort-setup)))
   (let loop ()