Changeset 15919 in project


Ignore:
Timestamp:
09/16/09 12:39:40 (10 years ago)
Author:
Ivan Raikov
Message:

prerelease now includes some important bug fixes to chicken-install

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/prerelease/chicken-install.scm

    r15229 r15919  
    132132          (else #f)))
    133133
     134  (define (meta-dependencies meta)
     135    (append
     136     (deps 'depends meta)
     137     (deps 'needs meta)
     138     (if *run-tests* (deps 'test-depends meta) '())))
     139
    134140  (define (outdated-dependencies meta)
    135     (let ((ds (append
    136                (deps 'depends meta)
    137                (deps 'needs meta)
    138                (if *run-tests* (deps 'test-depends meta) '()))))
     141    (let ((ds (meta-dependencies meta)))
    139142      (let loop ((deps ds) (missing '()) (upgrade '()))
    140143        (if (null? deps)
     
    172175
    173176  (define *eggs+dirs+vers* '())
     177  (define *dependencies* '())
    174178  (define *checked* '())
    175   (define *csi* (shellpath (make-pathname *program-path* "csi")))
    176  
     179  (define *csi* (shellpath (make-pathname *program-path* (foreign-value "C_CSI_PROGRAM" c-string))))
     180
    177181  (define (try-extension name version trans locn)
    178182    (condition-case
     
    190194       (print "HTTP protocol error")
    191195       (values #f "") ]
     196      [e (exn setup-download-error)
     197         (print "Server error:")
     198         (print-error-message e)
     199         (values #f "")]
    192200      [e ()
    193201       (abort e) ] ) )
     
    239247                  (unless dir (error "extension or version not found"))
    240248                  (print " " name " located at " dir)
    241                   (set! *eggs+dirs+vers* (alist-cons name (list dir ver) *eggs+dirs+vers*)) ) ) ] ) )
     249                  (set! *eggs+dirs+vers* (cons (list name dir ver) *eggs+dirs+vers*)) ) ) ] ) )
    242250     eggs)
    243251    (unless *retrieve-only*
     
    251259                      (print "checking dependencies for `" (car e+d+v) "' ...")
    252260                      (let-values ([(missing upgrade) (outdated-dependencies meta)])
     261                        (set! *dependencies*
     262                          (cons
     263                           (cons (car e+d+v) (append missing upgrade))
     264                           *dependencies*))
    253265                        (when (pair? missing)
    254266                          (print " missing: " (string-intersperse missing ", "))
     
    277289    (conc
    278290     *csi*
    279      " -bnq -e \"(require-library setup-api)\" -e \"(import setup-api)\""
     291     " -bnq -setup-mode -e \"(require-library setup-api)\" -e \"(import setup-api)\""
    280292     (sprintf " -e \"(extension-name-and-version '(\\\"~a\\\" \\\"~a\\\"))\"" (car e+d+v) (caddr e+d+v))
    281293     (if (sudo-install) " -e \"(sudo-install #t)\"" "")
     
    289301    (retrieve eggs)
    290302    (unless *retrieve-only*
    291       (for-each ; we assume the order reflects the dependency tree...
    292        (lambda (e+d+v)
    293          (print "installing " (car e+d+v) #\: (caddr e+d+v) " ...")
    294          (print "changing current directory to " (cadr e+d+v))
    295          (parameterize ((current-directory (cadr e+d+v)))
    296            (let ([cmd (make-install-command e+d+v)])
    297              (print "  " cmd)
    298              ($system cmd))
    299            (when (and *run-tests*
    300                       (file-exists? "tests")
    301                       (directory? "tests")
    302                       (file-exists? "tests/run.scm") )
    303              (current-directory "tests")
    304              (let ((cmd (sprintf "~a -s run.scm ~a" *csi* (car e+d+v))))
    305                (print "  " cmd)
    306                ($system cmd)))))
    307        *eggs+dirs+vers*)))
     303      (let ((dag (reverse (topological-sort *dependencies* string=?))))
     304        (print "install order:")
     305        (pp dag)
     306        (for-each
     307         (lambda (e+d+v)
     308           (print "installing " (car e+d+v) #\: (caddr e+d+v) " ...")
     309           (print "changing current directory to " (cadr e+d+v))
     310           (parameterize ((current-directory (cadr e+d+v)))
     311             (let ([cmd (make-install-command e+d+v)])
     312               (print "  " cmd)
     313               ($system cmd))
     314             (when (and *run-tests*
     315                        (file-exists? "tests")
     316                        (directory? "tests")
     317                        (file-exists? "tests/run.scm") )
     318               (current-directory "tests")
     319               (let ((cmd (sprintf "~a -s run.scm ~a" *csi* (car e+d+v))))
     320                 (print "  " cmd)
     321                 ($system cmd)))))
     322         (map (cut assoc <> *eggs+dirs+vers*) dag)))))
    308323
    309324  (define (cleanup)
     
    368383  -l   -location LOCATION       install from given location instead of default
    369384  -t   -transport TRANSPORT     use given transport instead of default
    370   -s   -sudo                    use sudo(1) for installing or removing files
     385  -s   -sudo                    use sudo(1) for filesystem operations
    371386  -r   -retrieve                only retrieve egg into current directory, don't install
    372387  -n   -no-install              do not install, just build (implies `-keep')
Note: See TracChangeset for help on using the changeset viewer.