Changeset 10012


Ignore:
Timestamp:
09/23/05 18:34:44 (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

    r10010 r10012  
    4848    (unless (and (pathnamep pathname)
    4949                 (not (typep pathname 'logical-pathname)))
    50       (format t "~&~S => ~S; expected ~S~%" pathname (type-of pathname) 'pathname)
     50;;       (format t "~&~S => ~S; expected ~S~%" pathname (type-of pathname) 'pathname)
    5151      (setf ok nil))
    5252    (unless (and (equal directory expected-directory)
    5353                 (equal name      expected-name)
    5454                 (equal type      expected-type))
    55       (format t "~&~S => ~S ~S ~S; expected ~S ~S ~S~%"
    56               pathname directory name type expected-directory expected-name expected-type)
     55;;       (format t "~&~S => ~S ~S ~S; expected ~S ~S ~S~%"
     56;;               pathname directory name type expected-directory expected-name expected-type)
    5757      (setf ok nil))
    5858    ok))
     
    9999  (declare (type string expected))
    100100  (let ((result (namestring (apply 'translate-pathname args))))
    101     (unless (equal result
    102                    #-windows expected
    103                    #+windows (substitute #\\ #\/ expected))
    104       (format t "(translate-pathname ~S ~S ~S) => ~S; expected ~S~%"
    105               (first args) (second args) (third args) result expected))))
     101;;     (unless (equal result
     102;;                    #-windows expected
     103;;                    #+windows (substitute #\\ #\/ expected))
     104;;       (format t "(translate-pathname ~S ~S ~S) => ~S; expected ~S~%"
     105;;               (first args) (second args) (third args) result expected))))
     106    (equal result
     107           #-windows expected
     108           #+windows (substitute #\\ #\/ expected))))
    106109
    107110(defmacro check-readable (pathname)
     
    212215  t)
    213216
     217(deftest physical.24
     218  (check-readable (make-pathname :name "."))
     219  t)
     220
    214221;; #p".."
    215 (deftest physical.24
     222(deftest physical.25
    216223  #+(or allegro)
    217224  (check-physical-pathname #p".." '(:relative :back) nil nil)
     
    229236  t)
    230237#+cmu
    231 (pushnew 'physical.24 rt:*expected-failures*)
     238(pushnew 'physical.25 rt:*expected-failures*)
    232239
    233240;; #p"../"
    234 (deftest physical.25
     241(deftest physical.26
    235242  #+allegro
    236243  (check-physical-pathname #p"../" '(:relative :back) nil nil)
     
    253260(pushnew 'lots-of-dots.2 rt:*expected-failures*)
    254261
    255 (deftest physical.26
     262(deftest physical.27
    256263  (check-physical-pathname #p"foo.*" nil "foo" :wild)
    257264  t)
    258265
    259266#-sbcl
    260 (deftest physical.27
     267(deftest physical.28
    261268  #-allegro
    262269  (string= (namestring (make-pathname :name "..")) "..")
     
    265272  t)
    266273
    267 (deftest physical.28
     274(deftest physical.29
    268275  (string= (namestring (make-pathname :directory '(:relative :up)))
    269276           #+windows "..\\"
     
    312319
    313320#+sbcl
    314 (deftest physical.29
     321(deftest physical.30
    315322  ;; Even though "effluvia" is defined as a logical host, "bop" is not a valid
    316323  ;; logical pathname version, so this can't be a logical pathname.
     
    452459  (check-namestring (translate-pathname "foo/bar" "*/bar" "*/baz") "foo/baz")
    453460  t)
    454 (expect (equal (translate-pathname "foo/bar" "*/bar" "*/baz") #p"foo/baz"))
    455 (expect (string= (namestring (translate-pathname "foo.bar" "*.*" "/usr/local/*.*"))
    456                  #-windows "/usr/local/foo.bar"
    457                  #+windows "\\usr\\local\\foo.bar"))
    458 (expect (equal (translate-pathname "foo.bar" "*.*" "/usr/local/*.*")
    459                #p"/usr/local/foo.bar"))
    460 
    461 (check-translate-pathname '("/foo/" "/*/" "/usr/local/*/") "/usr/local/foo/")
    462 (check-translate-pathname '("/foo/baz/bar.txt" "/**/*.*" "/usr/local/**/*.*")
    463                           "/usr/local/foo/baz/bar.txt")
    464 
    465 (expect (equal (translate-pathname "/foo/" "/*/" "/usr/local/*/bar/") #p"/usr/local/foo/bar/"))
    466 
    467 (expect (equal (translate-pathname "/foo/bar.txt" "/*/*.*" "/usr/local/*/*.*")
    468                #P"/usr/local/foo/bar.txt"))
     461(deftest translate-pathname.6
     462  (equal (translate-pathname "foo/bar" "*/bar" "*/baz") #p"foo/baz")
     463  t)
     464(deftest translate-pathname.7
     465  (string= (namestring (translate-pathname "foo.bar" "*.*" "/usr/local/*.*"))
     466           #-windows "/usr/local/foo.bar"
     467           #+windows "\\usr\\local\\foo.bar")
     468  t)
     469(deftest translate-pathname.8
     470  (equal (translate-pathname "foo.bar" "*.*" "/usr/local/*.*")
     471         #p"/usr/local/foo.bar")
     472  t)
     473
     474(deftest translate-pathname.9
     475  (check-translate-pathname '("/foo/" "/*/" "/usr/local/*/") "/usr/local/foo/")
     476  t)
     477(deftest translate-pathname.10
     478  (check-translate-pathname '("/foo/baz/bar.txt" "/**/*.*" "/usr/local/**/*.*")
     479                            "/usr/local/foo/baz/bar.txt")
     480  t)
     481
     482(deftest translate-pathname.11
     483  (equal (translate-pathname "/foo/" "/*/" "/usr/local/*/bar/") #p"/usr/local/foo/bar/")
     484  t)
     485
     486(deftest translate-pathname.12
     487  (equal (translate-pathname "/foo/bar.txt" "/*/*.*" "/usr/local/*/*.*")
     488         #P"/usr/local/foo/bar.txt")
     489  t)
    469490
    470491;; "TRANSLATE-PATHNAME translates SOURCE (that matches FROM-WILDCARD)..."
    471 (expect (not (pathname-match-p "/foo/bar.txt" "**/*.*")))
     492(deftest pathname-match-p.1
     493  (pathname-match-p "/foo/bar.txt" "**/*.*")
     494  nil)
    472495;; Since (pathname-match-p "/foo/bar.txt" "**/*.*" ) => NIL...
    473 #+(or clisp allegro abcl cmu)
    474 ;; This seems to be the correct behavior.
    475 (expect (signals-error (translate-pathname "/foo/bar.txt" "**/*.*" "/usr/local/**/*.*") 'error))
    476 #+(or sbcl)
    477 ;; This appears to be a bug, since SOURCE doesn't match FROM-WILDCARD.
    478 (expect (equal (translate-pathname "/foo/bar.txt" "**/*.*" "/usr/local/**/*.*")
    479                #p"/usr/local/foo/bar.txt"))
    480 
    481 (expect (pathname-match-p "/foo/bar.txt" "/**/*.*"))
    482 (expect (equal (translate-pathname "/foo/bar.txt" "/**/*.*" "/usr/local/**/*.*")
    483                #p"/usr/local/foo/bar.txt"))
     496(deftest translate-pathname.13
     497  #+(or clisp allegro abcl cmu)
     498  ;; This seems to be the correct behavior.
     499  (signals-error (translate-pathname "/foo/bar.txt" "**/*.*" "/usr/local/**/*.*") 'error)
     500  #+sbcl
     501  ;; This appears to be a bug, since SOURCE doesn't match FROM-WILDCARD.
     502  (equal (translate-pathname "/foo/bar.txt" "**/*.*" "/usr/local/**/*.*")
     503         #p"/usr/local/foo/bar.txt")
     504  t)
     505
     506(deftest pathname-match-p.2
     507  (pathname-match-p "/foo/bar.txt" "/**/*.*")
     508  t)
     509(deftest translate-pathname.14
     510  (equal (translate-pathname "/foo/bar.txt" "/**/*.*" "/usr/local/**/*.*")
     511         #p"/usr/local/foo/bar.txt")
     512  t)
     513
     514#-clisp
     515(deftest translate-pathname.15
     516  (equal (translate-pathname "foo.bar" "/**/*.*" "/usr/local/") #p"/usr/local/foo.bar")
     517  t)
    484518
    485519;; TRANSLATE-LOGICAL-PATHNAME
    486 #-clisp
    487 (expect (equal (translate-pathname "foo.bar" "/**/*.*" "/usr/local/") #p"/usr/local/foo.bar"))
    488 
    489520#+clisp
    490521(expect (equal (translate-logical-pathname "effluvia:foo.bar") #p"/usr/local/foo.bar"))
Note: See TracChangeset for help on using the changeset viewer.