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
; returns a version-number -> directory association table for the given package
(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
(dir->assoc-table path)
(hard-links pkg))))
(add-to-table
(dir->assoc-table pkg)
(hard-links pkg)))
;; assoc-table ::= (listof (list n n path))
(define empty-table '())
; dir->assoc-table : path -> assoc-table
; returns the association table for the given planet dir
(define (dir->assoc-table path)
; dir->assoc-table : FULL-PKG-SPEC -> assoc-table
; returns the on-disk packages for the given planet dir
(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)
(let ((maj (string->number majs))
(min (string->number mins)))
(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)))
(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
;; of planet requires that satisfy those linkages
(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)))
(map
(lambda (x) (cons (car x) (map (lambda (y) (drop-last (cadr y))) (cdr x))))