From e084b4d8960bb4f7501bc281af1cd65518e6557e Mon Sep 17 00:00:00 2001
From: Jim Ursetto <address@hidden>
Date: Wed, 13 Apr 2016 22:02:18 -0500
Subject: [PATCH 2/3] Replace chicken-install shell out to csi with direct call
 (#1277)

Calls to csi using the (system) call are changed to use
(process-run) instead, permitting blacklisted environment
variables such as DYLD_LIBRARY_PATH to work on OS X 10.11,
and addressing a problem with `make check` in bug #1277.
---
 chicken-install.scm | 102 +++++++++++++++++++++++++++++++---------------------
 1 file changed, 61 insertions(+), 41 deletions(-)

diff --git a/chicken-install.scm b/chicken-install.scm
index 610097d..1e25f7e 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -310,7 +310,7 @@
   (define *checked* '())
 
   (define *csi* 
-    (shellpath (make-pathname *program-path* C_CSI_PROGRAM)))
+    (normalize-pathname (make-pathname *program-path* C_CSI_PROGRAM)))
 
   (define (try-extension name version trans locn)
     (condition-case
@@ -525,43 +525,43 @@
 	path))
 
   (define (make-install-command egg-name egg-version dep?)
-    (conc
-     *csi*
-     " -bnq "
-     (if (or *deploy*
-	     (and *cross-chicken* ; disable -setup-mode when cross-compiling,
-		  (not *host-extension*))) ; host-repo must always take precedence
-	 ""
-	 "-setup-mode ")
-     "-e \"(require-library setup-api)\" -e \"(import setup-api)\" "
-     (if *debug-setup*
-	 ""
-	 "-e \"(setup-error-handling)\" ")
-     (sprintf "-e \"(extension-name-and-version '(\\\"~a\\\" \\\"~a\\\"))\""
-       egg-name egg-version)
-     (if (sudo-install) " -e \"(sudo-install #t)\"" "")
-     (if *keep* " -e \"(keep-intermediates #t)\"" "")
-     (if (and *no-install* (not dep?)) " -e \"(setup-install-mode #f)\"" "")
-     (if *host-extension* " -e \"(host-extension #t)\"" "")
-     (let ((prefix (get-prefix)))
-       (if prefix
-	   (sprintf " -e \"(destination-prefix \\\"~a\\\")\"" 
-	     (back-slash->forward-slash (normalize-pathname prefix)))
-	   ""))
-     (let ((prefix (get-prefix #t)))
-       (if prefix
-	   (sprintf " -e \"(runtime-prefix \\\"~a\\\")\"" 
-	     (back-slash->forward-slash (normalize-pathname prefix)))
-	   ""))
-     (if (pair? *csc-features*)
-	 (sprintf " -e \"(extra-features '~s)\"" *csc-features*)
-	 "")
-     (if (pair? *csc-nonfeatures*)
-	 (sprintf " -e \"(extra-nonfeatures '~s)\"" *csc-nonfeatures*)
-	 "")
-     (if *deploy* " -e \"(deployment-mode #t)\"" "")
-     #\space
-     (shellpath (string-append egg-name ".setup"))) )
+    `(,*csi*
+      -bnq
+      ,@(if (or *deploy*
+		(and *cross-chicken* ; disable -setup-mode when cross-compiling,
+		     (not *host-extension*))) ; host-repo must always take precedence
+	  '()
+	  '(-setup-mode))
+      -e "(require-library setup-api)"
+      -e "(import setup-api)"
+      ,@(if *debug-setup*
+	    '()
+	    '(-e "(setup-error-handling)"))
+      -e ,(sprintf "(extension-name-and-version '(\"~a\" \"~a\"))"
+		   egg-name egg-version)
+      ,@(if (sudo-install) '(-e "(sudo-install #t)") '())
+      ,@(if *keep* '(-e "(keep-intermediates #t)") '())
+      ,@(if (and *no-install* (not dep?)) '(-e "(setup-install-mode #f)") '())
+      ,@(if *host-extension* '(-e "(host-extension #t)") '())
+      ,@(let ((prefix (get-prefix)))
+	  (if prefix
+	      `(-e ,(sprintf "(destination-prefix \"~a\")"
+			     (back-slash->forward-slash (normalize-pathname prefix))))
+	      '()))
+      ,@(let ((prefix (get-prefix #t)))
+	  (if prefix
+	      `(-e ,(sprintf "(runtime-prefix \"~a\")" 
+			     (back-slash->forward-slash (normalize-pathname prefix))))
+	      '()))
+      ,@(if (pair? *csc-features*)
+	    `(-e ,(sprintf "(extra-features '~s)" *csc-features*))
+	    '())
+      ;; done to here
+      ,@(if (pair? *csc-nonfeatures*)
+	    `(-e ,(sprintf "(extra-nonfeatures '~s)" *csc-nonfeatures*))
+	    '())
+      ,@(if *deploy* '(-e "(deployment-mode #t)") '())
+      ,(string-append egg-name ".setup")))
 
   (define-syntax keep-going
     (syntax-rules ()
@@ -637,10 +637,10 @@
 				(let ((cmd (make-install-command
 					    (car e+d+v) (caddr e+d+v) (> i 1)))
 				      (name (car e+d+v)))
-				  (print "  " cmd)
+				  (print "  " (string-intersperse (map ->string cmd)))
 				  (keep-going 
 				   (name "installing")
-				   ($system cmd))
+				   ($exec (car cmd) (cdr cmd)))
 				  (when (and *run-tests*
 					     (not isdep)
 					     (file-exists? "tests")
@@ -650,7 +650,7 @@
 					(current-directory "tests")
 					(keep-going
 					 (name "testing")
-					 (command "~a -s run.scm ~a ~a" *csi* name (caddr e+d+v)))
+					 ($exec *csi* `(-s run.scm ,name ,(caddr e+d+v))))
 					(set! *running-test* #f))))
 			      (lambda ()
 				(change-directory old-dir)))))))
@@ -756,6 +756,26 @@
       (unless (zero? r)
         (error "shell command terminated with nonzero exit code" r str))))
 
+  ;; unlike $exec in csc.scm, this raises an error on failure.  verbose/dry-run are retained
+  ;; for now but unused.
+  (define verbose #f)
+  (define dry-run #f)
+  (define ($exec cmd args)
+    (let* ((args (map ->string args))
+	   (str (string-intersperse (cons cmd args)))) ; no quoting is rendered
+      (when verbose (print str))
+      (receive (_ normal return-code)
+	  (if dry-run
+	      (values #f #t 0)
+	      (process-wait (process-run cmd args)))
+	(cond ((= 0 return-code)
+	       (unless normal
+		 (error "unexpected 0 return code with abnormal exit" str)))
+	      (normal
+	       (error "command terminated with non-zero exit status" return-code str))
+	      (else
+	       (error "command terminated on signal" return-code str))))))
+
   (define (installed-extensions)
     (delete-duplicates
      (filter-map
-- 
2.2.1