Changeset 12289 in project


Ignore:
Timestamp:
10/29/08 02:42:50 (11 years ago)
Author:
Ivan Raikov
Message:

More bug fixes and additional unit tests.

Location:
release/3/filepath/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/3/filepath/trunk/filepath.scm

    r12288 r12289  
    223223  (let ((ecs (if (string? ext) (string->list ext) ext))
    224224        (pcs (if (string? p) (string->list p) p)))
    225     (if (prefix? ext-separator ecs)
    226         (append p ext)
    227         (append p (list ext-separator) ext))))
    228 
    229 (define (has-extension? p)  (member ext-separator p))
     225    (if (null? ecs) pcs
     226        (if (prefix? (list (ext-separator)) ecs)
     227            (append pcs ecs)
     228            (append pcs (list (ext-separator)) ecs)))))
     229
     230(define (has-extension? p)  (member (ext-separator) p))
    230231
    231232(define (split-all-extensions p)
    232233  (match-let (((a b)  (split-file-name p)))
    233234    (match (scatter is-ext-separator? b)
    234            ((c . d)  (list a (intersperse b ext-separator)))
     235           ((c . d)  (list a (intersperse b (ext-separator))))
    235236           (else     (list p (list))))))
    236237
     
    283284    (match pcs
    284285           (((and x (? is-letter?))  #\: (and y (? is-path-separator?)) . xs)
    285             (list (add-slash (list x #\:) (cons y xs))))
     286            (add-slash (list x #\:) (cons y xs)))
    286287           (((and x (? is-letter?)) #\: . xs) 
    287288            (list (list x #\:) xs))
     
    324325(define (drop-drive p)  (second (split-drive p)))
    325326
    326 (define (has-drive? p)  (not (string-null? (take-drive p))))
    327 
    328 (define (is-drive? p)   (string-null? (drop-drive p)))
     327(define (has-drive? p)  (not (null? (take-drive p))))
     328
     329(define (is-drive? p)   (null? (drop-drive p)))
    329330
    330331
     
    348349
    349350(define (replace-base-name p name)
    350   (match-let (((a b) (split-file-name p)))
    351     (let ((ext (take-extension b)))
    352       (combine-always a (append name (list ext-separator) ext)))))
     351  (let ((ncs (if (string? name) (string->list name) name)))
     352    (match-let (((a b) (split-file-name p)))
     353       (let* ((ext (take-extension b))
     354              (ext (if (prefix? (list (ext-separator)) ext) ext
     355                       (cons (ext-separator) ext))))
     356         (combine-always a (append ncs ext))))))
    353357
    354358;; Is an item either a directory or the last character a path separator?
    355359(define (has-trailing-path-separator? p)
    356360  (let ((pcs (if (string? p) (string->list p) p)))
    357     (if (null? pcs) #f (is-path-separator? (last pcs)))))
     361    (and (not (null? pcs)) (is-path-separator? (last pcs)))))
    358362 
    359363(define (add-trailing-path-separator p)
     
    417421        (let*-values (((a b) (break is-path-separator? y))
    418422                      ((c d) (break (lambda (x) (not (is-path-separator? x))) b)))
    419           (append (append a c) (f d)))))
     423          (cons (append a c) (f d)))))
    420424  (let ((pcs (if (string? p) (string->list p) p)))
    421425    (match-let (((drive path)  (split-drive pcs)))
    422                (append drive (f path)))))
    423            
    424            
     426               (append (if (null? drive) (list) (list drive)) (f path)))))
    425427
    426428;; Just as 'splitPath', but don't add the trailing slashes to each element.
    427429;; splitDirectories "test/file" == ["test","file"]
    428430;; splitDirectories "/test/file" == ["/","test","file"]
    429 ;; Valid x => joinPath (splitDirectories x) `equalFilePath` x
    430431;; splitDirectories "" == []
    431432
     
    437438         (path-components (split-path pcs)))
    438439    (if (has-drive? pcs)
    439         (cons (first (path-components)) (map g (cdr path-components)))
     440        (cons (car path-components) (map g (cdr path-components)))
    440441        (map g path-components))))
    441442
     
    482483;; Posix:   makeRelative "some/path" "some/path/a/b/c" == "a/b/c"
    483484
    484 ;;        takeAbs (x:_) | isPathSeparator x = [pathSeparator]
    485 ;;        takeAbs x = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x
    486485(define (make-relative root path)
    487486  (define (drop-abs p)
     
    491490  (define (take-abs p)
    492491    (match p (((and x (? is-path-separator?)) . xs) (list (path-separator)))
    493            (else (map (lambda (y) (if (is-path-separator? y) (path-separator) (char-downcase y))) (take-drive p)))))
    494 
    495   (define (f x y)
     492           (else (map (lambda (y) (if (is-path-separator? y) (path-separator) (char-downcase y)))
     493                      (take-drive p)))))
     494
     495  (define (f x y pcs)
    496496    (if (null? x) (drop-while is-path-separator? y)
    497497        (match-let (((x1 x2)  (g x))
    498498                    ((y1 y2)  (g y)))
    499                    (if (path-equal? x1 y1) (f x2 y2) path))))
     499                   (if (path-equal? x1 y1) (f x2 y2 pcs) pcs))))
    500500
    501501  (define (g x)
     
    508508    (cond ((path-equal? rcs pcs)  (list #\.))
    509509          ((not (equal? (take-abs rcs) (take-abs pcs)))  pcs)
    510           (else (f (drop-abs rcs) (drop-abs pcs))))))
     510          (else (f (drop-abs rcs) (drop-abs pcs) pcs)))))
    511511
    512512;; Normalise a file
     
    516516;;  Posix:   normalise "../bob/fred/" == "../bob/fred/"
    517517;;  Posix:   normalise "./bob/fred/" == "bob/fred/"
     518;;  Posix:   normalise "./" == "./"
    518519;;  Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\"
    519520;;  Windows: normalise "c:\\" == "C:\\"
     
    521522;;  Windows: normalise "c:/file" == "C:\\file"
    522523;;           normalise "." == "."
    523 ;;  Posix:   normalise "./" == "./"
    524524
    525525(define (normalise path)
     
    527527    (lambda (xs)
    528528      (match xs
    529              ((#\. . (and rest (? pair?))) ((drop-dots ax) rest))
     529             (((#\.) . (and rest (? pair?))) ((drop-dots ax) rest))
    530530             ((x . rest)  ((drop-dots (cons x ax)) rest))
    531531             (()          (reverse ax)))))
     
    536536            (prop-sep (cons a rest)))
    537537           (((and a (? is-path-separator?)) . rest)
    538             (cons (path-separator) (prop-sep rest)))))
     538            (cons (path-separator) (prop-sep rest)))
     539           ((x . rest)
     540            (cons x (prop-sep rest)))
     541           (() xs)))
    539542
    540543  (define f (compose join-path (drop-dots (list)) split-directories prop-sep))
     
    652655;; and convert it to a string
    653656
    654 (define (list-wrapper lst) (map list->string lst))
     657(define (list-wrapper lst)
     658  (begin ; (print "lst = " lst)
     659         (map list->string lst)))
    655660
    656661  ;; Path methods (environment $PATH)
     
    661666(define filepath:split-extension    (compose list-wrapper split-extension))
    662667(define filepath:take-extension     (compose list->string  take-extension))
     668(define filepath:drop-extension     (compose list->string drop-extension))
    663669(define filepath:replace-extension  (compose list->string replace-extension))
    664 (define filepath:drop-extension     (compose list->string drop-extension))
    665670(define filepath:add-extension      (compose list->string add-extension))
    666 (define filepath:split-all-extensions   (compose list->string split-all-extensions))
     671(define filepath:split-all-extensions   (compose list-wrapper split-all-extensions))
    667672(define filepath:drop-all-extensions    (compose list->string drop-all-extensions))
    668673(define filepath:take-all-extensions    (compose list->string take-all-extensions))
     
    670675
    671676;; Drive procedures
    672 (define filepath:split-drive  (compose list->string split-drive))
     677(define filepath:split-drive  (compose list-wrapper split-drive))
    673678(define filepath:join-drive   (compose list->string join-drive))
    674679(define filepath:take-drive   (compose list->string take-drive))
     
    678683
    679684;; Operations on a file path, as a list of directories
    680 (define filepath:split-file-name   (compose list->string split-file-name))
     685(define filepath:split-file-name   (compose list-wrapper split-file-name))
    681686(define filepath:take-file-name    (compose list->string take-file-name))
    682687(define filepath:replace-file-name (compose list->string replace-file-name))
     
    687692(define filepath:replace-directory (compose list->string replace-directory))
    688693(define filepath:combine           (compose list->string combine))
    689 (define filepath:split-path        (compose list->string split-path))
     694(define filepath:split-path        (compose list-wrapper split-path))
    690695(define filepath:join-path         (compose list->string join-path))
    691 (define filepath:split-directories (compose list->string split-directories))
     696(define filepath:split-directories (compose list-wrapper split-directories))
    692697
    693698;; Low-level procedures
  • release/3/filepath/trunk/tests/run.scm

    r12288 r12289  
    1111                (test  (sprintf "(split-search-path ~S) => ~S (Windows)" p ex)
    1212                      ex (filepath:split-search-path p)))
    13               (filepath:posix #t)
    1413              (let ((p "File1:File2:File3"))
     14                (filepath:posix #t)
    1515                (test (sprintf "(split-search-path ~S) => ~S (POSIX)" p ex)
    1616                      ex (filepath:split-search-path p)))))
    17 #|
    18 -- > splitExtension "file.txt" == ("file",".txt")
    19 -- > splitExtension "file" == ("file","")
    20 -- > splitExtension "file/file.txt" == ("file/file",".txt")
    21 -- > splitExtension "file.txt/boris" == ("file.txt/boris","")
    22 -- > splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext")
    23 -- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")
    24 -- > splitExtension "file/path.txt/" == ("file/path.txt/","")
    25 |#
    2617
    2718(define split-extension-tests
     
    4334
    4435
    45 
     36(define replace-extension-tests
     37  `((("file.txt" ".bob")  "file.bob")
     38    (("file.txt" "bob")  "file.bob")
     39    (("file" ".bob")  "file.bob")
     40    (("file.txt" "")  "file")
     41    (("file.fred.bob" "txt")  "file.fred.txt")))
     42
     43(test-group "replace-extension"
     44            (for-each (lambda (pr)
     45                        (let ((p (first pr)) (res (second pr)))
     46                          (test (sprintf "~S => ~S" (cons 'replace-extension p) res)
     47                                res (apply filepath:replace-extension p))))
     48                      replace-extension-tests))
     49
     50(define add-extension-tests
     51  `((("file.txt" "bib") "file.txt.bib")
     52    (("file." ".bib") "file..bib")
     53    (("file" ".bib") "file.bib")
     54    (("/" "x") "/.x")))
     55
     56
     57(test-group "add-extension"
     58            (for-each (lambda (pr)
     59                        (let ((p (first pr)) (res (second pr)))
     60                          (test (sprintf "~S => ~S" (cons 'add-extension p) res)
     61                                res (apply filepath:add-extension p))))
     62                      add-extension-tests))
     63
     64(define split-drive-windows-tests
     65  `(("file"  ("" "file"))
     66    ("c:/file"  ("c:/" "file"))
     67    ("c:\\file"  ("c:\\" "file"))
     68    ("\\\\shared\\test"  ("\\\\shared\\" "test"))
     69    ("\\\\shared"  ("\\\\shared" ""))
     70    ("\\\\?\\UNC\\shared\\file"  ("\\\\?\\UNC\\shared\\" "file"))
     71    ("\\\\?\\d:\\file"  ("\\\\?\\d:\\" "file"))
     72    ("/d"  ("" "/d"))))
     73
     74(define split-drive-posix-tests
     75  `(("/test"  ("/" "test"))
     76    ("//test"  ("//" "test"))
     77    ("test/file"  ("" "test/file"))
     78    ("file"  ("" "file"))))
     79
     80(test-group "split-drive"
     81            (filepath:posix #f)
     82            (for-each (lambda (pr)
     83                        (let ((p (first pr)) (res (second pr)))
     84                          (test (sprintf "~S => ~S" (list 'split-drive p) res)
     85                                res (filepath:split-drive p))))
     86                      split-drive-windows-tests)
     87            (filepath:posix #t)
     88            (for-each (lambda (pr)
     89                        (let ((p (first pr)) (res (second pr)))
     90                          (test (sprintf "~S => ~S" (list 'split-drive p) res)
     91                                res (filepath:split-drive p))))
     92                      split-drive-posix-tests))
     93
     94(define split-file-name-tests
     95  `(("file/bob.txt"  ("file/" "bob.txt"))
     96    ("file/" ("file/" ""))
     97    ("bob"   ("" "bob"))
     98    ("/"     ("/" ""))))
     99 
     100(test-group "split-file-name"
     101            (filepath:posix #f)
     102            (let ((p "c:") (res (list "c:" "")))
     103              (test (sprintf "~S => ~S" (list 'split-file-name p) res)
     104                    res (filepath:split-file-name p)))
     105            (filepath:posix #t)
     106            (for-each (lambda (pr)
     107                        (let ((p (first pr)) (res (second pr)))
     108                          (test (sprintf "~S => ~S" (list 'split-file-name p) res)
     109                                res (filepath:split-file-name p))))
     110                      split-file-name-tests))
     111
     112(define take-directory-windows-tests
     113  `(("foo\\bar"      "foo")
     114    ("foo\\bar\\\\"  "foo\\bar")
     115    ("C:\\"          "C:\\")))
     116
     117(define take-directory-posix-tests
     118  `(("/foo/bar/baz"  "/foo/bar")
     119    ("/foo/bar/baz/" "/foo/bar/baz")))
     120
     121
     122(test-group "take-directory"
     123            (filepath:posix #f)
     124            (for-each (lambda (pr)
     125                        (let ((p (first pr)) (res (second pr)))
     126                          (test (sprintf "~S => ~S" (list 'take-directory p) res)
     127                                res (filepath:take-directory p))))
     128                      take-directory-windows-tests)
     129            (filepath:posix #t)
     130            (for-each (lambda (pr)
     131                        (let ((p (first pr)) (res (second pr)))
     132                          (test (sprintf "~S => ~S" (list 'take-directory p) res)
     133                                res (filepath:take-directory p))))
     134                      take-directory-posix-tests))
     135
     136(define split-path-tests
     137  `(("test//item/" ("test//" "item/"))
     138    ("test/item/file" ("test/" "item/" "file"))
     139    ("" ())
     140    ("/file/test" ("/" "file/" "test"))))
     141
     142(test-group "split-path"
     143            (filepath:posix #f)
     144            (let ((p "c:\\test\\path") (res (list "c:\\" "test\\" "path")))
     145              (test (sprintf "~S => ~S" (list 'split-path p) res)
     146                    res (filepath:split-path p)))
     147            (filepath:posix #t)
     148            (for-each (lambda (pr)
     149                        (let ((p (first pr)) (res (second pr)))
     150                          (test (sprintf "~S => ~S" (list 'split-path p) res)
     151                                res (filepath:split-path p))))
     152                      split-path-tests))
     153
     154(define make-relative-windows-tests
     155  `((("C:\\Home" "c:\\home\\bob") "bob")
     156    (("C:\\Home" "D:\\Home\\Bob") "D:\\Home\\Bob")))
     157
     158(define make-relative-posix-tests
     159  `((("/Home" "/home/bob") "/home/bob")
     160    (("/home/" "/home/bob/foo/bar") "bob/foo/bar")
     161    (("/fred" "bob") "bob")
     162    (("/file/test" "/file/test/fred") "fred")
     163    (("/file/test" "/file/test/fred/") "fred/")
     164    (("some/path" "some/path/a/b/c") "a/b/c")))
     165
     166(test-group "make-relative"
     167            (filepath:posix #f)
     168            (for-each (lambda (pr)
     169                        (let ((p (first pr)) (res (second pr)))
     170                          (test (sprintf "~S => ~S" (cons 'make-relative p) res)
     171                                res (apply filepath:make-relative p))))
     172                      make-relative-windows-tests)
     173            (filepath:posix #t)
     174            (for-each (lambda (pr)
     175                        (let ((p (first pr)) (res (second pr)))
     176                          (test (sprintf "~S => ~S" (cons 'make-relative p) res)
     177                                res (apply filepath:make-relative p))))
     178                      make-relative-posix-tests))
     179
     180(define normalise-posix-tests
     181  `(("/file/\\test////"  "/file/\\test/")
     182    ("/file/./test"  "/file/test")
     183    ("/test/file/../bob/fred/"  "/test/file/../bob/fred/")
     184    ("../bob/fred/"  "../bob/fred/")
     185    ("./bob/fred/"   "bob/fred/")
     186    ("./"  "./")))
     187
     188(define normalise-windows-tests
     189  `(("c:\\file/bob\\"  "C:\\file\\bob\\")
     190    ("c:\\"  "C:\\")
     191    ("\\\\server\\test"  "\\\\server\\test")
     192    ("c:/file"  "C:\\file")
     193    ("."  ".")))
     194
     195
     196(test-group "normalise"
     197            (filepath:posix #f)
     198            (for-each (lambda (pr)
     199                        (let ((p (first pr)) (res (second pr)))
     200                          (test (sprintf "~S => ~S" (list 'normalise p) res)
     201                                res (filepath:normalise p))))
     202                      normalise-windows-tests)
     203            (filepath:posix #t)
     204            (for-each (lambda (pr)
     205                        (let ((p (first pr)) (res (second pr)))
     206                          (test (sprintf "~S => ~S" (list 'normalise p) res)
     207                                res (filepath:normalise p))))
     208                      normalise-posix-tests))
     209
     210
     211
Note: See TracChangeset for help on using the changeset viewer.