From dc232ed059a0af5955d21f077da88af6fdc562a0 Mon Sep 17 00:00:00 2001 From: Julian Graham Date: Wed, 9 Jun 2010 23:57:00 -0400 Subject: [PATCH] Resolve issues in `find-versioned-module'. * module/ice-9/boot-9.scm (find-versioned-module): Perform a stable sort on version numbers of matched libraries; eliminate extra path separator in library file path. --- module/ice-9/boot-9.scm | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index f5870cdf7..12714bd6c 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -2346,7 +2346,7 @@ If there is no handler at all, Guile prints an error and then exits." (cond ((> (car lst1) (car lst2)) #t) ((< (car lst1) (car lst2)) #f) (else (numlist-less (cdr lst1) (cdr lst2))))))) - (numlist-less (car pair1) (car pair2))) + (not (numlist-less (car pair2) (car pair1)))) (define (match-version-and-file pair) (and (version-matches? version-ref (car pair)) (let ((filenames @@ -2354,7 +2354,7 @@ If there is no handler at all, Guile prints an error and then exits." (let ((s (false-if-exception (stat file)))) (and s (eq? (stat:type s) 'regular)))) (map (lambda (ext) - (string-append (cdr pair) "/" name ext)) + (string-append (cdr pair) name ext)) %load-extensions)))) (and (not (null? filenames)) (cons (car pair) (car filenames)))))) @@ -2365,12 +2365,14 @@ If there is no handler at all, Guile prints an error and then exits." (let ((entry (readdir dstrm))) (if (eof-object? entry) subdir-pairs - (let* ((subdir (string-append (cdr root-pair) "/" entry)) + (let* ((subdir (string-append (cdr root-pair) entry)) (num (string->number entry)) - (num (and num (append (car root-pair) (list num))))) + (num (and num (exact? num) (append (car root-pair) + (list num))))) (if (and num (eq? (stat:type (stat subdir)) 'directory)) - (filter-subdir - root-pair dstrm (cons (cons num subdir) subdir-pairs)) + (filter-subdir + root-pair dstrm (cons (cons num (string-append subdir "/")) + subdir-pairs)) (filter-subdir root-pair dstrm subdir-pairs)))))) (or (and (null? root-pairs) ret)