~ chicken-core (chicken-5) d9e4a38a5d5779bfe82168fd055022348d32ad16
commit d9e4a38a5d5779bfe82168fd055022348d32ad16
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Oct 8 03:28:03 2010 -0400
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Fri Oct 8 03:28:03 2010 -0400
setup-download deletes *.so's with local transport
diff --git a/chicken-install.scm b/chicken-install.scm
index 9583541e..79473b24 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -263,7 +263,8 @@
password: *password*
trunk: *trunk*
proxy-host: *proxy-host*
- proxy-port: *proxy-port*)
+ proxy-port: *proxy-port*
+ clean: (not *retrieve-only*))
[(exn net)
(print "TCP connect timeout")
(values #f "") ]
diff --git a/setup-download.scm b/setup-download.scm
index 0cfeac69..74eacae6 100644
--- a/setup-download.scm
+++ b/setup-download.scm
@@ -90,7 +90,7 @@
(map (cut string-append <> "\n") (directory eggdir))))
(else "unknown\n"))))
- (define (locate-egg/local egg dir #!optional version destination)
+ (define (locate-egg/local egg dir #!optional version destination clean)
(let* ((eggdir (make-pathname dir egg))
(tagdir (make-pathname eggdir "tags"))
(tagver (and (not *trunk*)
@@ -116,8 +116,18 @@
(if (zero? (system cmd))
(values dest ver)
(values #f ""))))
- (else (values src ver))))))
-
+ (else
+ ;; remove *.so files in toplevel dir, just for being careful
+ (when clean
+ (let ((sos (filter (cut string-suffix? ".so" <>) (directory src))))
+ (for-each
+ (lambda (f)
+ (d " deleting leftover ~a from local directory~%" f)
+ (delete-file* f))
+ sos)))
+ (values src ver))))))
+
+;;XXX is this used anywhere?
(define (gather-egg-information dir)
(let ((ls (directory dir)))
(filter-map
@@ -351,13 +361,13 @@
(define (retrieve-extension name transport location
#!key version quiet destination username password tests
- proxy-host proxy-port trunk (mode 'default))
+ proxy-host proxy-port trunk (mode 'default) clean)
(fluid-let ((*quiet* quiet)
(*trunk* trunk)
(*mode* mode))
(case transport
((local)
- (locate-egg/local name location version destination) )
+ (locate-egg/local name location version destination clean) )
((svn)
(locate-egg/svn name location version destination username password) )
((http)
Trap