suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Bugfix for package crashing bug

Browse Source 
svn: r1914
This commit is contained in:
Jacob Matthews 2006-01-21 19:01:36 +00:00
parent 4b27eba829
commit b4b965180e
2 changed files with 12 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/planet/private/planet-shared.ss
View File

@ -49,23 +49,23 @@ Various common pieces of code that both the client and server need to access
; build-assoc-table : FULL-PKG-SPEC -> assoc-table ; build-assoc-table : FULL-PKG-SPEC -> assoc-table
; returns a version-number -> directory association table for the given package ; returns a version-number -> directory association table for the given package
(define (build-assoc-table pkg) (define (build-assoc-table pkg)
(let ((path (build-path (apply build-path (CACHE-DIR) (pkg-spec-path pkg)) (pkg-spec-name pkg)))) (add-to-table
(add-to-table (dir->assoc-table pkg)
(dir->assoc-table path) (hard-links pkg)))
(hard-links pkg))))
;; assoc-table ::= (listof (list n n path)) ;; assoc-table ::= (listof (list n n path))
(define empty-table '()) (define empty-table '())
; dir->assoc-table : path -> assoc-table ; dir->assoc-table : FULL-PKG-SPEC -> assoc-table
; returns the association table for the given planet dir ; returns the on-disk packages for the given planet dir
(define (dir->assoc-table path) (define (dir->assoc-table pkg)
(define path (build-path (apply build-path (CACHE-DIR) (pkg-spec-path pkg)) (pkg-spec-name pkg)))
(define (tree-stuff->row-or-false p majs mins) (define (tree-stuff->row-or-false p majs mins)
(let ((maj (string->number majs)) (let ((maj (string->number majs))
(min (string->number mins))) (min (string->number mins)))
(if (and (path? p) maj min) (if (and (path? p) maj min)
(list maj min (build-path path majs mins)) (list (pkg-spec-name pkg) (pkg-spec-path pkg) maj min (build-path path majs mins))
#f))) #f)))
(if (directory-exists? path) (if (directory-exists? path)

5
collects/planet/util.ss
View File

@ -120,7 +120,10 @@
;; gives the current "linkage table"; a table that links modules to particular versions ;; gives the current "linkage table"; a table that links modules to particular versions
;; of planet requires that satisfy those linkages ;; of planet requires that satisfy those linkages
(define (current-linkage) (define (current-linkage)
(let* ((links (with-input-from-file (LINKAGE-FILE) read-all)) (let* ((links
(if (file-exists? (LINKAGE-FILE))
(with-input-from-file (LINKAGE-FILE) read-all)
'()))
(buckets (categorize caar links))) (buckets (categorize caar links)))
(map (map
(lambda (x) (cons (car x) (map (lambda (y) (drop-last (cadr y))) (cdr x)))) (lambda (x) (cons (car x) (map (lambda (y) (drop-last (cadr y))) (cdr x))))