Changeset 20509 in project


Ignore:
Timestamp:
09/25/10 17:27:57 (8 years ago)
Author:
sjamaan
Message:

uri-generic: Change remove-body-dot-segments behaviour: it used to accidentally pass the leading / symbol of an absolute path to the remove-dot-segments procedure. This didn't cause problems but it could if we change the implementation later.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/uri-generic/trunk/uri-generic.scm

    r20486 r20509  
    873873                                scheme: (uri-scheme base)
    874874                                authority: (uri-auth base)
    875                                 path: (merge-paths base (URI-path ref))))))
     875                                path: (merge-paths base ref-path)))))
    876876             ((uri-query ref) (update-URI ref
    877877                                          scheme: (uri-scheme base)
     
    889889(define (merge0 pb pr)
    890890  (let* ((rpb  (reverse pb))
    891          (pb1  (reverse (if (pair? rpb) (cdr rpb) rpb))))
     891         (pb1  (reverse (match rpb      ; RFC3986, section 5.2.3, second bullet
     892                               ((_ . rst) rst)
     893                               (else rpb)))))
    892894    (append pb1 pr)))
    893895
    894 (define (merge-paths b pr)  ; pr is a path, *not* a URI object
     896(define (merge-paths b pr)  ; pr is a relative path, *not* a URI object
    895897  (let ((ba (uri-authority b))
    896898        (pb (uri-path b)))
    897899    (let ((mp (if (and ba (null? pb))
    898                   (merge0 '(/ "") pr) ; RFC3986, section 5.2.3, first bullet
     900                  (cons '/ pr) ; RFC3986, section 5.2.3, first bullet
    899901                  (merge0 pb pr))))
    900902      (remove-dot-segments mp))))
    901903
    902 ;;  Remove dot segments, but protect leading '/' character
     904;;  Remove dot segments, but protect leading '/' symbol
    903905
    904906(define (remove-dot-segments ps)
     
    982984
    983985(define (remove-body-dot-segments p)
    984   (or (and (pair? p)
    985            (let ((r (reverse p)))
    986              (reverse (cons (car r) (remove-dot-segments (cdr r))))))
    987       p))
     986  (match p
     987         (('/ segs ... last)
     988          (cons '/ (reverse (cons last (remove-dot-segments (reverse segs))))))
     989         ((segs ... last)
     990          (reverse (cons last (remove-dot-segments (reverse segs)))))
     991         (else p)))
    988992
    989993(define (rel-path-from pabs base)
Note: See TracChangeset for help on using the changeset viewer.