Changeset 10002


Ignore:
Timestamp:
09/22/05 16:36:30 (16 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/tests/pathname-tests.lisp

    r10001 r10002  
    6363  (declare (type string expected))
    6464  (let ((result (namestring (apply 'translate-pathname args))))
    65     (unless (equal result expected)
     65    (unless (equal result
     66                   #-windows expected
     67                   #+windows (substitute #\\ #\/ expected))
    6668      (format t "(translate-pathname ~S ~S ~S) => ~S; expected ~S~%"
    6769              (first args) (second args) (third args) result expected))))
     
    6971(defmacro check-readable (pathname)
    7072  `(expect (equal ,pathname (read-from-string (write-to-string ,pathname :readably t)))))
     73
     74(defmacro check-namestring (pathname namestring)
     75  `(expect (string= (namestring ,pathname)
     76                    #+windows (substitute #\\ #\/ ,namestring)
     77                    #-windows ,namestring)))
    7178
    7279(check-physical-pathname #p"/" '(:absolute) nil nil)
     
    152159(expect (string= (namestring (make-pathname :name "..")) "../"))
    153160
    154 (expect (string= (namestring (make-pathname :directory '(:relative :up))) "../"))
     161(expect (string= (namestring (make-pathname :directory '(:relative :up)))
     162                 #+windows "..\\"
     163                 #-windows "../"))
    155164
    156165;; Silly names.
    157 #+clisp
     166#+(or abcl clisp)
    158167(expect (signals-error (make-pathname :name "abc/def") 'error))
    159 #-(or allegro clisp sbcl)
     168#-(or abcl allegro clisp sbcl)
    160169(check-readable (make-pathname :name "abc/def"))
    161170
     
    309318                 "test.text"))
    310319
    311 (expect (string= (namestring (translate-pathname "foo/bar" "*/bar" "*/baz"))
    312                  "foo/baz"))
     320(check-namestring (translate-pathname "foo/bar" "*/bar" "*/baz") "foo/baz")
    313321(expect (equal (translate-pathname "foo/bar" "*/bar" "*/baz") #p"foo/baz"))
    314322(expect (string= (namestring (translate-pathname "foo.bar" "*.*" "/usr/local/*.*"))
    315                  "/usr/local/foo.bar"))
     323                 #-windows "/usr/local/foo.bar"
     324                 #+windows "\\usr\\local\\foo.bar"))
    316325(expect (equal (translate-pathname "foo.bar" "*.*" "/usr/local/*.*")
    317326               #p"/usr/local/foo.bar"))
    318327
    319 ;; (expect (equal (translate-pathname "/foo/" "/*/" "/usr/local/*/") #p"/usr/local/foo/"))
    320328(check-translate-pathname '("/foo/" "/*/" "/usr/local/*/") "/usr/local/foo/")
    321329(check-translate-pathname '("/foo/baz/bar.txt" "/**/*.*" "/usr/local/**/*.*")
     
    356364;;                          '(:absolute "usr" "local") "foo" "bar")
    357365(expect (string= (namestring (translate-logical-pathname "effluvia:foo.bar"))
    358                  "/usr/local/foo.bar"))
     366                 #-windows "/usr/local/foo.bar"
     367                 #+windows "\\usr\\local\\foo.bar"))
    359368;; (check-physical-pathname (translate-logical-pathname "effluvia:foo;bar.txt")
    360369;;                          '(:absolute "usr" "local" "foo") "bar" "txt")
    361370(expect (string= (namestring (translate-logical-pathname "effluvia:foo;bar.txt"))
    362                  "/usr/local/foo/bar.txt"))
     371                 #-windows "/usr/local/foo/bar.txt"
     372                 #+windows "\\usr\\local\\foo\\bar.txt"))
    363373
    364374#-allegro
     
    391401                               (logical-pathname "demo0:tmp;**;*.*.*"))))
    392402#-clisp
    393 (expect (equal (namestring (translate-logical-pathname "demo0:file.lisp"))
    394                "/tmp/file.lisp"))
     403(check-namestring (translate-logical-pathname "demo0:file.lisp") "/tmp/file.lisp")
    395404
    396405(setf (logical-pathname-translations "demo1")
     
    398407;; Remove "**" from the resulting pathname when the source directory is NIL.
    399408(expect (not (equal (namestring (translate-logical-pathname "demo1:foo.lisp"))
    400                     "/tmp/**/foo.lisp")))
    401 (expect (equal (namestring (translate-logical-pathname "demo1:foo.lisp"))
    402                "/tmp/foo.lisp"))
     409                    #-windows "/tmp/**/foo.lisp"
     410                    #+windows "\\tmp\\**\\foo.lisp")))
     411(check-namestring (translate-logical-pathname "demo1:foo.lisp") "/tmp/foo.lisp")
    403412;;; Check for absolute/relative path confusion.
    404413(expect (not (pathname-match-p "demo1:;foo.lisp" "**;*.*.*")))
     
    409418(expect (pathname-match-p "demo1:;foo.lisp" ";**;*.*.*"))
    410419(expect (equal (namestring (translate-logical-pathname "demo1:;foo.lisp"))
    411                #-allegro "/tmp/rel/foo.lisp"
     420               #+(and abcl windows) "\\tmp\\rel\\foo.lisp"
     421               #+(and abcl unix) "/tmp/rel/foo.lisp"
     422               #-(or allegro abcl) "/tmp/rel/foo.lisp"
    412423               #+allegro "/tmp/foo.lisp"))
    413424
     
    460471(expect (signals-error (translate-logical-pathname "bazooka:todemo;x.y") 'error))
    461472#-(or allegro clisp)
    462 (expect (equal (namestring (translate-logical-pathname "bazooka:todemo;x.y")) "/tmp/x.y"))
     473(expect (equal (namestring (translate-logical-pathname "bazooka:todemo;x.y"))
     474               #-windows "/tmp/x.y"
     475               #+windows "\\tmp\\x.y"))
    463476#+clisp ;; BUG
    464477(expect (signals-error (translate-logical-pathname "demo0:x.y") 'error))
    465478#-clisp
    466 (expect (equal (namestring (translate-logical-pathname "demo0:x.y")) "/tmp/x.y"))
     479(expect (equal (namestring (translate-logical-pathname "demo0:x.y"))
     480               #-windows "/tmp/x.y"
     481               #+windows "\\tmp\\x.y"))               
    467482#-(or allegro clisp)
    468483(expect (equal (namestring (translate-logical-pathname "bazooka:todemo;x.y"))
     
    480495(setf (logical-pathname-translations "test0")
    481496      '(("**;*.*.*"              "/library/foo/**/")))
    482 (expect (equal (namestring (translate-logical-pathname
    483                             "test0:foo;bar;baz;mum.quux"))
    484                "/library/foo/foo/bar/baz/mum.quux"))
     497(check-namestring (translate-logical-pathname "test0:foo;bar;baz;mum.quux")
     498                  "/library/foo/foo/bar/baz/mum.quux")
    485499(setf (logical-pathname-translations "prog")
    486500      '(("RELEASED;*.*.*"        "MY-UNIX:/sys/bin/my-prog/")
     
    491505      '(("CODE;*.*.*"             "/lib/prog/")))
    492506#-allegro
    493 (expect (equal (namestring (translate-logical-pathname
    494                             "prog:code;documentation.lisp"))
    495                "/lib/prog/documentation.lisp"))
     507(check-namestring (translate-logical-pathname "prog:code;documentation.lisp")
     508                  "/lib/prog/documentation.lisp")
    496509(setf (logical-pathname-translations "prog")
    497510      '(("CODE;DOCUMENTATION.*.*" "/lib/prog/docum.*")
    498511        ("CODE;*.*.*"             "/lib/prog/")))
    499512#-allegro
    500 (expect (equal (namestring (translate-logical-pathname
    501                             "prog:code;documentation.lisp"))
    502                "/lib/prog/docum.lisp"))
     513(check-namestring (translate-logical-pathname "prog:code;documentation.lisp")
     514                  "/lib/prog/docum.lisp")
    503515
    504516;; "ANSI section 19.3.1.1.5 specifies that translation to a filesystem which
    505517;; doesn't have versions should ignore the version slot. CMU CL didn't ignore
    506518;; this as it should, but we [i.e. SBCL] do."
    507 (expect (equal (namestring (translate-logical-pathname
    508                             "test0:foo;bar;baz;mum.quux.3"))
    509                "/library/foo/foo/bar/baz/mum.quux"))
     519(check-namestring (translate-logical-pathname "test0:foo;bar;baz;mum.quux.3")
     520                  "/library/foo/foo/bar/baz/mum.quux")
    510521
    511522(eval-when (:compile-toplevel :load-toplevel :execute)
     
    599610         (frob pathname-type))))
    600611
    601 (expect (string=
    602          (namestring (parse-namestring "/foo" (host-namestring #p"/bar")))
    603          "/foo"))
     612(check-namestring (parse-namestring "/foo" (host-namestring #p"/bar")) "/foo")
    604613(expect (string=
    605614         (namestring (parse-namestring "FOO" (host-namestring #p"SCRATCH:BAR")))
Note: See TracChangeset for help on using the changeset viewer.