Changeset 10019


Ignore:
Timestamp:
09/24/05 16:59:19 (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

    r10017 r10019  
    102102  `(equal ,pathname (read-from-string (write-to-string ,pathname :readably t))))
    103103
     104(defun check-readable-or-signals-error (pathname)
     105  (handler-case
     106      (equal pathname (read-from-string (write-to-string pathname :readably t)))
     107    (print-not-readable () t)))
     108
    104109(defmacro check-namestring (pathname namestring)
    105110  `(string= (namestring ,pathname)
     
    566571
    567572;; TRANSLATE-LOGICAL-PATHNAME
     573
     574;; "PATHNAME is first coerced to a pathname. If the coerced pathname is a
     575;; physical pathname, it is returned."
     576(deftest translate-logical-pathname.1
     577  (equal (translate-logical-pathname #p"/") #p"/")
     578  t)
     579
    568580#+(or abcl clisp)
    569 (deftest translate-logical-pathname.1
     581(deftest translate-logical-pathname.2
    570582  (equal (translate-logical-pathname "effluvia:foo.bar") #p"/usr/local/foo.bar")
    571583  t)
    572584
    573585#+(or sbcl cmu)
    574 (deftest translate-logical-pathname.2
     586(deftest translate-logical-pathname.3
    575587  ;; Device mismatch.
    576588  (and (eq (pathname-device (translate-logical-pathname "effluvia:foo.bar"))
     
    580592  t)
    581593
    582 (deftest translate-logical-pathname.3
     594(deftest translate-logical-pathname.4
    583595  (check-namestring (translate-logical-pathname "effluvia:foo.bar")
    584596                    "/usr/local/foo.bar")
    585597  t)
    586598
    587 (deftest translate-logical-pathname.4
     599(deftest translate-logical-pathname.5
    588600  (check-namestring (translate-logical-pathname "effluvia:foo;bar.txt")
    589601                    "/usr/local/foo/bar.txt")
    590602  t)
    591603
    592 (deftest translate-logical-pathname.5
     604(deftest translate-logical-pathname.6
    593605  #-allegro
    594606  (check-logical-pathname #p"effluvia:Foo.Bar" "EFFLUVIA" '(:absolute) "FOO" "BAR" nil)
     
    600612;; "TRANSLATE-PATHNAME [and thus also TRANSLATE-LOGICAL-PATHNAME] maps
    601613;; customary case in SOURCE into customary case in the output pathname."
    602 (deftest translate-logical-pathname.6
     614(deftest translate-logical-pathname.7
    603615  #-allegro
    604616  (check-physical-pathname (translate-logical-pathname #p"effluvia:Foo.Bar")
     
    961973  t)
    962974
     975#-clisp
     976(deftest sbcl.45
     977  (check-namestring (translate-logical-pathname "/") "/")
     978  t)
     979
     980(deftest sbcl.46
     981  (signals-error (pathname (make-string-input-stream "FOO"))
     982                 #-allegro 'type-error
     983                 #+allegro 'stream-error)
     984  t)
     985
     986(deftest sbcl.47
     987  (signals-error (merge-pathnames (make-string-output-stream))
     988                 #-allegro 'type-error
     989                 #+allegro 'stream-error)
     990  t)
     991
     992(deftest sbcl.48
     993  (check-readable-or-signals-error (make-pathname :name "foo" :type "txt" :version :newest))
     994  t)
     995(deftest sbcl.49
     996  (check-readable-or-signals-error (make-pathname :name "foo" :type "txt" :version 1))
     997  t)
     998(deftest sbcl.50
     999  (check-readable-or-signals-error (make-pathname :name "foo" :type ".txt"))
     1000  t)
     1001(deftest sbcl.51
     1002  (check-readable-or-signals-error (make-pathname :name "foo." :type "txt"))
     1003  t)
     1004(deftest sbcl.52
     1005  (check-readable-or-signals-error (parse-namestring "SCRATCH:FOO.TXT.1"))
     1006  t)
     1007(deftest sbcl.53
     1008  (check-readable-or-signals-error (parse-namestring "SCRATCH:FOO.TXT.NEWEST"))
     1009  t)
     1010(deftest sbcl.54
     1011  (check-readable-or-signals-error (parse-namestring "SCRATCH:FOO.TXT"))
     1012  t)
     1013
     1014(deftest sbcl.55
     1015  (equal (parse-namestring "foo" nil "/")
     1016         (parse-namestring "foo" nil #p"/"))
     1017  t)
     1018
     1019(deftest sbcl.56
     1020  (let ((test "parse-namestring-test.tmp"))
     1021    (unwind-protect
     1022        (with-open-file (f test :direction :output)
     1023          ;; FIXME: This test is a bit flaky, since we only check that
     1024          ;; no error is signalled. The dilemma here is "what is the
     1025          ;; correct result when defaults is a _file_, not a
     1026          ;; directory". Currently (0.8.10.73) we get #P"foo" here (as
     1027          ;; opposed to eg. #P"/path/to/current/foo"), which is
     1028          ;; possibly mildly surprising but probably conformant.
     1029          (equal (parse-namestring "foo" nil f) #p"foo"))
     1030      (when (probe-file test)
     1031        (delete-file test))))
     1032  t)
     1033
     1034;;; ENOUGH-NAMESTRING should probably not fail when the namestring in
     1035;;; question has a :RELATIVE pathname.
     1036(deftest sbcl.57
     1037  (equal (enough-namestring #p"foo" #p"./") "foo")
     1038  t)
     1039
     1040;;; bug reported by Artem V. Andreev: :WILD not handled in unparsing
     1041;;; directory lists.
     1042(deftest sbcl.58
     1043  (equal (namestring #p"/tmp/*/") "/tmp/*/")
     1044  t)
     1045
     1046(deftest sbcl.59
     1047  (string= (with-standard-io-syntax (write-to-string #p"/foo")) "#P\"/foo\"")
     1048  t)
     1049(deftest sbcl.60
     1050  (string= (with-standard-io-syntax (write-to-string #p"/foo" :readably nil))
     1051           "#P\"/foo\"")
     1052  t)
     1053(deftest sbcl.61
     1054  (string= (with-standard-io-syntax (write-to-string #p"/foo" :escape nil))
     1055           "#P\"/foo\"")
     1056  t)
     1057(deftest sbcl.62
     1058  (string= (with-standard-io-syntax (write-to-string #p"/foo" :readably nil :escape nil))
     1059           "/foo")
     1060  t)
     1061
    9631062(do-tests)
Note: See TracChangeset for help on using the changeset viewer.