Changeset 36964 in project


Ignore:
Timestamp:
12/04/18 22:03:55 (9 days ago)
Author:
sjamaan
Message:

uri-generic: Apply changes from relative-paths branch manually

Location:
release/5/uri-generic/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/uri-generic/trunk/tests/run.scm

    r36554 r36964  
    1111    ("http://ex/x/y/z" "http://ex/x/r" "../r")
    1212
    13     ("http://ex/x/y"  "http://ex/x/q/r" "./q/r")
    14     ("http://ex/x/y"  "http://ex/x/q/r#s" "./q/r#s")
    15     ("http://ex/x/y"  "http://ex/x/q/r#s/t" "./q/r#s/t")
     13    ("http://ex/x/y"  "http://ex/x/q/r" "q/r")
     14    ("http://ex/x/y"  "http://ex/x/q/r#s" "q/r#s")
     15    ("http://ex/x/y"  "http://ex/x/q/r#s/t" "q/r#s/t")
    1616    ("http://ex/x/y"  "ftp://ex/x/q/r" "ftp://ex/x/q/r")
    17     ("http://ex/x/y"  "http://ex/x/y"   "")
    18     ("http://ex/x/y/" "http://ex/x/y/"  "")
    19     ("http://ex/x/y/pdq" "http://ex/x/y/pdq" "")
    20     ("http://ex/x/y/" "http://ex/x/y/z/" "./z/")
    21     ("file:/swap/test/animal.rdf" "file:/swap/test/animal.rdf#Animal" "#Animal")
     17    ("http://ex/x/y"  "http://ex/x/y"   "y")
     18    ("http://ex/x/y/" "http://ex/x/y/"  ".")
     19    ("http://ex/x/y/pdq" "http://ex/x/y/pdq" "pdq")
     20    ("http://ex/x/y/" "http://ex/x/y/z/" "z/")
     21    ("file:/swap/test/animal.rdf" "file:/swap/test/animal.rdf#Animal" "animal.rdf#Animal")
    2222    ("file:/e/x/y/z" "file:/e/x/abc" "../abc")
    23     ("file:/example2/x/y/z" "file:/example/x/abc" "/example/x/abc")   
     23    ("file:/example2/x/y/z" "file:/example/x/abc" "../../../example/x/abc")
    2424    ("file:/ex/x/y/z" "file:/ex/x/r" "../r")
    25     ("file:/ex/x/y/z" "file:/r" "/r")       
    26     ("file:/ex/x/y" "file:/ex/x/q/r" "./q/r")
    27     ("file:/ex/x/y" "file:/ex/x/q/r#s" "./q/r#s")
    28     ("file:/ex/x/y" "file:/ex/x/q/r#" "./q/r#")
    29     ("file:/ex/x/y" "file:/ex/x/q/r#s/t" "./q/r#s/t")
     25    ("file:/ex/x/y/z" "file:/r" "../../../r")
     26    ("file:/ex/x/y" "file:/ex/x/q/r" "q/r")
     27    ("file:/ex/x/y" "file:/ex/x/q/r#s" "q/r#s")
     28    ("file:/ex/x/y" "file:/ex/x/q/r#" "q/r#")
     29    ("file:/ex/x/y" "file:/ex/x/q/r#s/t" "q/r#s/t")
    3030    ("file:/ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r")
    31     ("file:/ex/x/y" "file:/ex/x/y" "")
    32     ("file:/ex/x/y/" "file:/ex/x/y/" "")
    33     ("file:/ex/x/y/pdq" "file:/ex/x/y/pdq" "")
    34     ("file:/ex/x/y/" "file:/ex/x/y/z/" "./z/")
     31    ("file:/ex/x/y" "file:/ex/x/y" "y")
     32    ("file:/ex/x/y/" "file:/ex/x/y/" ".")
     33    ("file:/ex/x/y/pdq" "file:/ex/x/y/pdq" "pdq")
     34    ("file:/ex/x/y/" "file:/ex/x/y/z/" "z/")
    3535    ("file:/devel/WWW/2000/10/swap/test/reluri-1.n3" "file://meetings.example.com/cal#m1"
    3636     "//meetings.example.com/cal#m1")
    3737    ("file:/home/connolly/w3ccvs/WWW/2000/10/swap/test/reluri-1.n3" "file://meetings.example.com/cal#m1"
    3838     "//meetings.example.com/cal#m1")
    39     ("file:/some/dir/foo" "file:/some/dir/#blort" "./#blort")
    40     ("file:/some/dir/foo" "file:/some/dir/#" "./#")
     39    ("file:/some/dir/foo" "file:/some/dir/#blort" ".#blort")
     40    ("file:/some/dir/foo" "file:/some/dir/#" ".#")
    4141    ;; From Graham Klyne Thu 20 Feb 2003 18:08:17 +0000
    42     ("http://example/x/y%2Fz"  "http://example/x/abc"     "./abc")
    43     ("http://example/x/y/z"    "http://example/x%2Fabc"   "/x%2Fabc")
    44     ("http://example/x/y%2Fz"  "http://example/x%2Fabc"   "/x%2Fabc")
    45     ("http://example/x%2Fy/z"  "http://example/x%2Fy/abc" "./abc")
     42    ("http://example/x/y%2Fz"  "http://example/x/abc"     "abc")
     43    ("http://example/x/y/z"    "http://example/x%2Fabc"   "../../x%2Fabc")
     44    ("http://example/x/y%2Fz"  "http://example/x%2Fabc"   "../x%2Fabc")
     45    ("http://example/x%2Fy/z"  "http://example/x%2Fy/abc" "abc")
    4646    ;; Ryan Lee
    47     ("http://example/x/abc.efg" "http://example/x/" "./")
     47    ("http://example/x/abc.efg" "http://example/x/" ".")
    4848    ))
    4949
     
    145145
    146146(define reverse-extra-cases
    147   `((,base ,base "")
    148     (,base "http://a/b/c/e" "./e")
    149     (,base "http://a/b/c/" "./")  ;; Not sure if the trailing slash belongs here
     147  `((,base ,base "d;p")
     148    (,base "http://a/b/c/e" "e")
     149    (,base "http://a/b/c/" ".")
    150150    (,base "http://a/b/e" "../e")
    151151    (,base "http://a/b/c" "../c") ;; Slightly weird: dir in base, file in target
    152     (,base "http://a/b/" "../")
    153     (,base "http://a/" "/") ;; or "../../"
     152    (,base "http://a/b/" "..")
     153    (,base "http://a/" "../..") ;; or "/", but that's not convenient
    154154    (,base "http://a" "//a") ; No relative representation possible
    155155    (,base "http://b" "//b")
     
    157157    (,base "http://b/c" "//b/c")
    158158    (,base "ftp://a/b/c/d;p?q" "ftp://a/b/c/d;p?q")
    159     (,base "ftp://x/y/z;a?b" "ftp://x/y/z;a?b")))
     159    (,base "ftp://x/y/z;a?b" "ftp://x/y/z;a?b")
     160    ;; Found by Jim Ursetto.  This would become "", which is not
     161    ;; right when both are directories (see second case)
     162    ("/foo/bar" "/foo/bar" "bar")
     163    ("/foo/bar/" "/foo/bar/" ".")))
    160164
    161165(test-group "uri test"
  • release/5/uri-generic/trunk/uri-generic.scm

    r36561 r36964  
    11851185
    11861186(define (uri-relative-from uabs base)
    1187   (cond ((ucdiff? uri-scheme uabs base)      (update-URI uabs))
     1187  (cond ((ucdiff? uri-scheme uabs base)    (update-URI uabs))
    11881188        ((ucdiff? uri-authority uabs base) (update-URI uabs 'scheme #f))
    11891189        ;; Special case: no relative representation for http://a/ -> http://a
     
    12041204                     'path (list)))
    12051205        (else
    1206         (update-URI uabs
     1206        (update-URI uabs
    12071207                     'scheme #f
    12081208                     'authority #f
    12091209                     'query #f
    1210                      'path (list)))))
     1210                     'path (match (uri-path uabs)
     1211                             (("") (list ""))
     1212                             ((p ... "") (list "."))
     1213                             ((p ... last) (list last)))))))
    12111214
    12121215(define (ucdiff? sel u1 u2)
     
    12231226         ((pabs ()) pabs)
    12241227         ((() base) (list))
    1225          ;; Construct a relative path segment if the paths share a
    1226          ;; leading segment other than a leading '/'
    1227          ((('/ . (and sa1 (ra1 . ra2))) ('/ . (and sb1 (rb1 . rb2))))
    1228           (make-rel-path
    1229            (if (string=? ra1 rb1)
    1230                (rel-path-from1 sa1 sb1)
    1231                pabs)))
     1228         ;; Construct a relative path segment
     1229         ((('/ . sa1) ('/ . sb1))
     1230          (rel-path-from1 sa1 sb1))
    12321231         (else (uri-error 'rel-path-from "Both URI paths must be absolute" pabs base))))
    1233 
    1234 (define (make-rel-path x)
    1235   (match x
    1236          ((or ('/ . rst) ("." . rst) (".." . rst)) x)
    1237          (else (cons "." x))))
    12381232
    12391233;;  rel-path-from1 strips off trailing names from the supplied paths,
     
    12421236  (match-let* (((na . sa)  (reverse pabs)) 
    12431237               ((nb . sb)  (reverse base)))
    1244      (let ((rp (rel-segs-from (reverse sa) (reverse sb))))
    1245        (if (null? rp)  (cond ((string=? na nb)  (list))
    1246                              (else              (list na)))
    1247            (append rp (list na))))))
     1238    (let ((rp (rel-segs-from (reverse sa) (reverse sb))))
     1239      (match rp
     1240        (() (cond ((string=? na nb) (list))
     1241                  ((string=? na "") (list "."))
     1242                  (else (list na))))
     1243        ((rp1 ... (or ".." "."))
     1244         (if (string=? na "") rp (append rp (list na))))
     1245        (else (append rp (list na)) )))))
    12481246
    12491247                         
Note: See TracChangeset for help on using the changeset viewer.