Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Sane handling of multiple repos basing the local cache name on the remote uri.

Browse source 
Still need to support a list of repos and/or sibling repos.
This commit is contained in:
Alex Shinn 2015-05-06 15:25:34 +09:00
parent 218ceb9144
commit d05b5c2d92
2 changed files with 14 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
lib/chibi/snow/commands.scm
View file

@ -1056,9 +1056,16 @@
(or (conf-get cfg 'local-user-repository)
(make-path (conf-get-snow-dir cfg) "repo")))))
(define (repository-local-path cfg)
(let* ((repo-uri (remote-uri cfg 'repository-uri "/s/repo.scm"))
(repo-id (substring (sha-224 (string->utf8 repo-uri)) 0 32))
(local-dir (repository-dir cfg))
(local-base (string-append "repo-" repo-id ".scm")))
(make-path local-dir local-base)))
(define (update-repository cfg)
(let* ((local-dir (repository-dir cfg))
(local-path (make-path local-dir "repo.scm"))
(let* ((local-path (repository-local-path cfg))
(local-dir (path-directory local-path))
(local-tmp (string-append local-path ".tmp."
(number->string (current-second)) "-"
(number->string (current-process-id))))
@ -1082,10 +1089,10 @@
repo)))))
(define (repository-stale? cfg)
(let ((path (make-path (repository-dir cfg) "repo.scm")))
(let ((local-path (repository-local-path cfg)))
(guard (exn (else #t))
(> (current-second)
(+ (file-modification-time path)
(+ (file-modification-time local-path)
;; by default update once every 3 hours
(conf-get cfg 'update-refresh (* 3 60 60)))))))
@ -1102,12 +1109,13 @@
(warn "unknown update-stategy: " (conf-get cfg 'update-strategy))
#f)))
;; return the repo sexp
(define (maybe-update-repository cfg)
(or (guard (exn (else #f))
(and (should-update-repository? cfg)
(update-repository cfg)))
(guard (exn (else '(repository)))
(call-with-input-file (make-path (repository-dir cfg) "repo.scm")
(call-with-input-file (repository-local-path cfg)
read))))
(define (command/update cfg spec)

6
tests/snow/snow-tests.scm
View file

@ -134,7 +134,6 @@
--test tests/snow/repo1/leonardo/fibonacci-test.scm
tests/snow/repo1/leonardo/fibonacci.sld)
(snow index ,(cadr repo1) tests/snow/repo1/leonardo-fibonacci-1.0.tgz)
(snow ,@repo1 update)
(snow ,@repo1 install --show-tests leonardo.fibonacci)
(test "1.0" (installed-version (snow-status) '(leonardo fibonacci)))
@ -145,7 +144,6 @@
--test tests/snow/repo2/leonardo/fibonacci-test.scm
tests/snow/repo2/leonardo/fibonacci.sld)
(snow index ,(cadr repo2))
(snow ,@repo2 update)
(snow ,@repo2 upgrade leonardo.fibonacci)
(test "1.1" (installed-version (snow-status) '(leonardo fibonacci)))
@ -191,7 +189,6 @@
--test "tests/snow/repo3/pythagoras/hypotenuse-test.sch"
tests/snow/repo3/pythagoras/hypotenuse.sch)
(snow index ,(cadr repo3))
(snow ,@repo3 update)
(snow ,@repo3 install pingala.binomial)
(snow ,@repo3 install euler.totient)
(let ((status (snow-status)))
@ -233,7 +230,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; other implementations
(snow ,@repo2 update)
(snow ,@repo2 --implementations "gauche,kawa,larceny"
install leonardo.fibonacci)
(let ((status (snow-status --implementations "gauche,kawa,larceny")))
@ -241,8 +237,6 @@
(test "1.1" (installed-version status '(leonardo fibonacci) 'kawa))
(test "1.1" (installed-version status '(leonardo fibonacci) 'larceny)))
(snow ,@repo3 update)
(snow ,@repo3 --implementations "chicken" --program-implementation "chicken"
install pingala.triangle)
(let ((status (snow-status --implementations "chicken")))