~ chicken-core (chicken-5) 298e78cddafd9c9f4f443588739ac898bb845e10
commit 298e78cddafd9c9f4f443588739ac898bb845e10
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Aug 19 22:45:04 2016 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sun Nov 13 11:32:21 2016 +0100
bugfixes in chicken-do and script-generation/execution
diff --git a/chicken-do.c b/chicken-do.c
index c2fe6b2a..401920f8 100644
--- a/chicken-do.c
+++ b/chicken-do.c
@@ -28,14 +28,14 @@ int main(int argc, char *argv[])
char **args = (char **)malloc(sizeof(char *) * argc);
char *target;
struct stat st, sd;
- int quiet = 0;
+ int quiet = 0, opts = 1;
if(argc < 3) usage(1);
target = argv[ 1 ];
for(i = 2; i < argc; ++i) {
- if(*argv[ i ] == '-') {
+ if(opts && *argv[ i ] == '-') {
switch(argv[ i ][ 1 ]) {
case 'q': quiet = 1; break;
case 'h': usage(0);
@@ -43,13 +43,16 @@ int main(int argc, char *argv[])
}
}
else if(!strcmp(argv[ i ], ":")) break;
- else args[ a++ ] = argv[ i ];
+ else {
+ args[ a++ ] = argv[ i ];
+ opts = 0;
+ }
}
if(i == argc) usage(1);
args[ a ] = NULL;
-
+
if(stat(target, &st) == -1) {
if(errno == ENOENT) goto build;
diff --git a/egg-compile.scm b/egg-compile.scm
index 4bd800b9..91201e1d 100644
--- a/egg-compile.scm
+++ b/egg-compile.scm
@@ -267,15 +267,13 @@
;; collect information
(for-each compile info)
;; sort topologically, by dependencies
- (let ((order (reverse
- (topological-sort
- (map (lambda (dep)
- (cons (car dep)
- (filter-deps
- (car dep)
- (get-keyword dependencies: (cdr dep)))))
- exts)
- dep=?))))
+ (let ((order (reverse (topological-sort
+ (map (lambda (dep)
+ (cons (car dep)
+ (filter-deps (car dep) (get-keyword dependencies:
+ (cdr dep)))))
+ (append prgs exts))
+ dep=?))))
;; generate + return build/install commands
(values
;; build commands
@@ -285,12 +283,14 @@
(let* ((data (assq t exts))
(link (get-keyword linkage: (cdr data))))
(append
- (if (memq 'static link)
- `((compile-static-extension ,@data))
- '())
(if (memq 'dynamic link)
`((compile-dynamic-extension ,@data))
'())
+ ;; static must come last, as *.o file will be overwritten
+ ;; and removed by dynamic build (meh)
+ (if (memq 'static link)
+ `((compile-static-extension ,@data))
+ '())
(if (uses-compiled-import-library? mode)
`((compile-import-library ,@data))
'())
@@ -300,12 +300,12 @@
(lambda (prg cmds)
(let ((link (get-keyword linkage: (cdr prg))))
(append
- (if (memq 'static link)
- `((compile-static-program ,@prg))
- '())
(if (memq 'dynamic link)
`((compile-dynamic-program ,@prg))
'())
+ (if (memq 'static link)
+ `((compile-static-program ,@prg))
+ '())
cmds)))
'()
prgs))
@@ -559,11 +559,11 @@ EOF
))))
(define ((install-suffix mode name info) platform)
- (let ((infostr (with-output-to-string (cut pp info)))
- (dir (destination-repository mode))
- (qdir (quotearg (slashify dir platform)))
- (dest (quotearg (slashify (make-pathname dir name +egg-info-extension+)
- platform))))
+ (let* ((infostr (with-output-to-string (cut pp info)))
+ (dir (destination-repository mode))
+ (qdir (quotearg (slashify dir platform)))
+ (dest (quotearg (slashify (make-pathname dir name +egg-info-extension+)
+ platform))))
(case platform
((unix)
(printf #<<EOF
diff --git a/new-install.scm b/new-install.scm
index 2038da4c..d7cfdcce 100644
--- a/new-install.scm
+++ b/new-install.scm
@@ -279,7 +279,7 @@
(lversion (get-egg-property info 'version)))
(cond ((and (file-exists? timestamp)
(> (- now (with-input-from-file timestamp read)) +one-hour+)
- (not (check-server-version name version lversion)))
+ (not (check-remote-version name version lversion)))
(fetch)
(let ((info (load-egg-info eggfile))) ; new egg info (fetched)
(values cached (get-egg-property info 'version))))
@@ -333,14 +333,25 @@
platform)))
(system cmd)))
-(define (check-server-version name version lversion)
- (let loop ((srvs default-servers))
- (and (pair? srvs)
- (let ((versions (try-list-versions name (car srvs))))
- (or (and versions
- (any (cut version>=? <> version) versions))
- (loop (cdr srvs)))))))
-
+(define (check-remote-version name version lversion)
+ (let loop ((locs default-locations))
+ (cond ((null? locs)
+ (let loop ((srvs default-servers))
+ (and (pair? srvs)
+ (let ((versions (try-list-versions name (car srvs))))
+ (or (and versions
+ (any (cut version>=? <> version) versions))
+ (loop (cdr srvs)))))))
+ ((probe-dir (make-pathname (car locs) name))
+ => (lambda (dir)
+ (let* ((eggfile (make-pathname dir name +egg-extension+))
+ (info (load-egg-info eggfile))
+ (rversion (get-egg-property info 'version)))
+ (or (and rversion
+ (version>=? rversion version))
+ (loop (cdr locs))))))
+ (else (loop (cdr locs))))))
+
;; retrieve eggs, recursively (if needed)
@@ -607,7 +618,7 @@
(d "running script ~a~%" script)
(if (eq? platform 'windows)
(exec script)
- (exec (string-append "sh " (make-pathname "." script))))
+ (exec (string-append "sh " script)))
(change-directory old))))
(define (write-info name info mode)
Trap