Changeset 10044


Ignore:
Timestamp:
09/26/05 19:32:53 (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

    r10042 r10044  
    22;;;
    33;;; Copyright (C) 2005 Peter Graves
    4 ;;; $Id: pathname-tests.lisp,v 1.29 2005-09-26 17:08:55 piso Exp $
     4;;; $Id: pathname-tests.lisp,v 1.30 2005-09-26 19:32:53 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    136136  (equal (make-pathname :name "foo" :type "bar" :version nil)
    137137         (make-pathname :name "foo" :type "bar" :version :newest))
    138   #+(or clisp cmu) nil
    139   #-(or clisp cmu) t)
     138  #+(or clisp cmu lispworks) nil
     139  #-(or clisp cmu lispworks) t)
    140140
    141141(deftest sxhash.1
     
    169169  t)
    170170(deftest physical.3
     171  #-lispworks
    171172  (check-physical-pathname #p"/foo." '(:absolute) "foo" "")
     173  #+lispworks
     174  (check-physical-pathname #p"/foo." '(:absolute) "foo." nil)
    172175  t)
    173176(deftest physical.4
     
    175178  t)
    176179(deftest physical.5
     180  #-lispworks
    177181  (check-physical-pathname #p"/foo.bar." '(:absolute) "foo.bar" "")
     182  #+lispworks
     183  (check-physical-pathname #p"/foo.bar." '(:absolute) "foo.bar." nil)
    178184  t)
    179185(deftest physical.6
     
    214220  t)
    215221(deftest physical.17
     222  #-lispworks
    216223  (check-physical-pathname #p".lisprc" nil ".lisprc" nil)
     224  #+lispworks
     225  (check-physical-pathname #p".lisprc" nil "" "lisprc")
    217226  t)
    218227(deftest physical.18
     
    230239  (check-readable (make-pathname :name "."))
    231240  t)
     241#+lispworks
     242(pushnew 'physical.20 *expected-failures*)
    232243
    233244;; #p"."
     
    239250  (check-physical-pathname #p"." nil "." nil)
    240251  t)
    241 #+cmu
     252#+(or cmu lispworks)
    242253(pushnew 'physical.21 *expected-failures*)
     254
     255(deftest physical.21a
     256  (equal #p"." #p"")
     257  nil)
     258#+lispworks
     259(pushnew 'physical.21a *expected-failures*)
    243260
    244261;; #p"./"
     
    251268  (check-physical-pathname #p"./" '(:relative ".") nil nil)
    252269  t)
    253 #+cmu
     270#+(or cmu lispworks)
    254271(pushnew 'physical.22 *expected-failures*)
     272
     273(deftest physical.22a
     274  (equal #p"./" #p"")
     275  nil)
     276#+lispworks
     277(pushnew 'physical.22a *expected-failures*)
     278
    255279
    256280(deftest physical.23
     
    261285  t)
    262286
    263 #-(or clisp sbcl)
     287#-(or sbcl)
    264288(deftest physical.24
    265289  (check-readable (make-pathname :name ".."))
    266290  t)
     291#+(or clisp lispworks)
     292(pushnew 'physical.24 *expected-failures*)
    267293
    268294;; #p".."
     
    270296  #+(or allegro)
    271297  (check-physical-pathname #p".." '(:relative :back) nil nil)
    272   #+(or abcl cmu)
     298  #+(or abcl cmu lispworks)
    273299  (check-physical-pathname #p".." '(:relative :up) nil nil)
    274300  ;; Other implementations think it's a file.
     
    289315  #+allegro
    290316  (check-physical-pathname #p"../" '(:relative :back) nil nil)
    291   #+(or abcl sbcl cmu clisp)
     317  #+(or abcl sbcl cmu clisp lispworks)
    292318  (check-physical-pathname #p"../" '(:relative :up) nil nil)
    293319  t)
     
    333359  (check-readable (make-pathname :name "abc/def"))
    334360  t)
    335 #+cmu
     361#+(or cmu lispworks)
    336362(pushnew 'silly.1 *expected-failures*)
    337363
     
    346372  (check-physical-pathname #p"foo:bar.baz.42" nil "foo:bar.baz" "42")
    347373  t)
     374#+lispworks
     375(pushnew 'logical.1 *expected-failures*)
    348376
    349377;; Define a logical host.
     
    354382#-allegro
    355383(deftest logical-pathname-translations.1
    356   #+(or sbcl cmu)
     384  #+(or sbcl cmu lispworks)
    357385  (equal (logical-pathname-translations "effluvia")
    358386         '(("**;*.*.*" "/usr/local/**/*.*")))
     
    405433(deftest logical.7
    406434  (check-namestring (parse-namestring "**;*.*.*" "effluvia")
    407                     #-allegro "EFFLUVIA:**;*.*.*"
     435                    #-(or allegro lispworks)
     436                    "EFFLUVIA:**;*.*.*"
     437                    #+allegro
    408438                    ;; Allegro preserves case and drops the version component.
    409                     #+allegro "effluvia:**;*.*")
     439                    "effluvia:**;*.*"
     440                    #+lispworks
     441                    "effluvia:**;*.*.*")
    410442  t)
    411443
     
    500532(deftest parse-namestring.2
    501533  (check-namestring (parse-namestring "foo.bar" "effluvia")
    502                     #-allegro "EFFLUVIA:FOO.BAR"
    503                     #+allegro "effluvia:foo.bar")
     534                    #-(or allegro lispworks) "EFFLUVIA:FOO.BAR"
     535                    #+allegro "effluvia:foo.bar"
     536                    #+lispworks "effluvia:FOO.BAR")
    504537  t)
    505538
     
    624657;; Since (pathname-match-p "/foo/bar.txt" "**/*.*" ) => NIL...
    625658(deftest translate-pathname.17
    626   #+(or clisp allegro abcl cmu)
     659  #+(or clisp allegro abcl cmu lispworks)
    627660  ;; This seems to be the correct behavior.
    628661  (signals-error (translate-pathname "/foo/bar.txt" "**/*.*" "/usr/local/**/*.*") 'error)
     
    758791  (equal (enough-namestring "demo2:test;foo.lisp")
    759792         #+sbcl "DEMO2:;TEST;FOO.LISP"
    760          #+cmu "DEMO2:TEST;FOO.LISP"
     793         #+(or cmu lispworks) "DEMO2:TEST;FOO.LISP"
    761794         #+clisp "TEST;FOO.LISP"
    762795         #+allegro "/test/foo.lisp" ;; BUG
     
    839872(deftest sbcl.20
    840873  (signals-error (logical-pathname-translations "unregistered-host")
    841                  #+clisp 'error ;; BUG
     874                 #+(or clisp lispworks) 'error ;; BUG
    842875                 #+cmu 'file-error ;; BUG
    843                  #-(or clisp cmu) 'type-error)
     876                 #-(or clisp lispworks cmu) 'type-error)
    844877  t)
    845878
     
    847880  (string-equal (host-namestring (parse-namestring "OTHER-HOST:ILLEGAL/LPN")) "OTHER-HOST")
    848881  nil)
     882#+lispworks
     883(pushnew 'sbcl.21 *expected-failures*)
     884
    849885(deftest sbcl.22
    850886  (string= (pathname-name (parse-namestring "OTHER-HOST:ILLEGAL/LPN")) "LPN")
     
    881917;; doesn't have versions should ignore the version slot. CMU CL didn't ignore
    882918;; this as it should, but we [i.e. SBCL] do."
     919;; "Some file systems do not have versions. Logical pathname translation to
     920;; such a file system ignores the version." 19.3.1.1.5
    883921#-cmu
    884922;; CMUCL supports emacs-style versions.
     
    887925                    "/library/foo/foo/bar/baz/mum.quux")
    888926  t)
    889 
    890 ;; (eval-when (:compile-toplevel :load-toplevel :execute)
    891   (setf (logical-pathname-translations "scratch")
    892         '(("**;*.*.*" "/usr/local/doc/**/*")))
    893 ;;   )
     927#+lispworks
     928(pushnew 'sbcl.26 *expected-failures*)
     929
     930(setf (logical-pathname-translations "scratch")
     931      '(("**;*.*.*" "/usr/local/doc/**/*")))
    894932
    895933;; Trivial merge.
     
    945983                         #p"SCRATCH:FOO;NAME2")
    946984  t)
     985
    947986(deftest sbcl.35
    948987  (check-merge-pathnames #p"scratch:;foo" #p"/usr/local/doc/"
    949                          #-(or allegro clisp) #P"SCRATCH:USR;LOCAL;DOC;FOO"
     988                         #-(or allegro clisp lispworks) #P"SCRATCH:USR;LOCAL;DOC;FOO"
    950989                         #+allegro #p"/usr/local/doc/foo"
    951                          #+clisp #p"SCRATCH:;FOO")
    952   t)
     990                         #+clisp #p"SCRATCH:;FOO"
     991                         #+lispworks #p"SCRATCH:FOO")
     992  t)
     993
    953994(deftest sbcl.36
    954995  (check-merge-pathnames #p"scratch:supplied-dir;" #p"/dir/name.type"
     
    9611002                                        :type "type"))
    9621003  t)
     1004
    9631005(deftest sbcl.37
    9641006  (check-merge-pathnames #p"scratch:;supplied-name" #p"/dir/name.type"
    965                          #-(or allegro clisp) #p"SCRATCH:DIR;SUPPLIED-NAME.TYPE"
    966                          #+allegro #p"/usr/local/doc/supplied-name.type"
     1007                         #-(or allegro clisp lispworks)
     1008                         #p"SCRATCH:DIR;SUPPLIED-NAME.TYPE"
     1009                         #+allegro
     1010                         #p"/usr/local/doc/supplied-name.type"
    9671011                         #+clisp
    9681012                         ;; #P"SCRATCH:;SUPPLIED-NAME.type.NEWEST"
     
    9701014                                        :directory '(:relative)
    9711015                                        :name "SUPPLIED-NAME"
    972                                         :type "type"))
    973   t)
     1016                                        :type "type")
     1017                         #+lispworks
     1018                         ;; #P"SCRATCH:SUPPLIED-NAME.TYPE.NEWEST"
     1019                         (make-pathname :host "SCRATCH"
     1020                                        :directory '(:absolute)
     1021                                        :name "SUPPLIED-NAME"
     1022                                        :type "TYPE"))
     1023  t)
     1024
    9741025(deftest sbcl.38
    9751026  (check-merge-pathnames (make-pathname :host "scratch" :type "supplied-type")
    9761027                         #p"/dir/name.type"
    977                          #-(or allegro clisp) #p"SCRATCH:DIR;NAME.SUPPLIED-TYPE"
    978                          #+allegro #p"/usr/local/doc/name.supplied-type"
     1028                         #-(or allegro clisp lispworks)
     1029                         #p"SCRATCH:DIR;NAME.SUPPLIED-TYPE"
     1030                         #+allegro
     1031                         #p"/usr/local/doc/name.supplied-type"
    9791032                         #+clisp
    9801033                         ;; #P"SCRATCH:dir;name.supplied-type.NEWEST"
     
    9821035                                        :directory '(:absolute "dir")
    9831036                                        :name "name"
    984                                         :type "supplied-type"))
    985   t)
     1037                                        :type "supplied-type")
     1038                         #+lispworks
     1039                         ;; #P"SCRATCH:NAME.SUPPLIED-TYPE.NEWEST"
     1040                         (make-pathname :host "SCRATCH"
     1041                                        :directory '(:absolute)
     1042                                        :name "NAME"
     1043                                        :type "SUPPLIED-TYPE"))
     1044  t)
     1045
    9861046(deftest sbcl.39
    9871047  #-allegro
     
    9901050                                        :name "bar")
    9911051                         #p"/aaa/bbb/ccc/ddd/eee"
    992                          #-clisp #p"SCRATCH:AAA;BBB;CCC;DDD;FOO;BAR"
     1052                         #-(or clisp lispworks)
     1053                         #p"SCRATCH:AAA;BBB;CCC;DDD;FOO;BAR"
    9931054                         #+clisp
    9941055                         ;; #P"SCRATCH:;foo;bar"
    9951056                         (make-pathname :host "SCRATCH"
    9961057                                        :directory '(:relative "foo")
    997                                         :name "bar"))
     1058                                        :name "bar")
     1059                         #+lispworks
     1060                         #p"SCRATCH:FOO;BAR")
    9981061  #+allegro
    9991062  (signals-error (merge-pathnames (make-pathname :host "scratch"
     
    10031066                 'error)
    10041067  t)
     1068
    10051069(deftest sbcl.40
    1006   #-allegro
     1070  #-(or allegro lispworks)
    10071071  (check-merge-pathnames (make-pathname :host "scratch"
    10081072                                        :directory '(:relative :back "foo")
     
    10151079                                        :directory '(:relative :back "foo")
    10161080                                        :name "bar"))
    1017   #+allegro
     1081  #+(or allegro lispworks)
    10181082  (signals-error (merge-pathnames (make-pathname :host "scratch"
    10191083                                                 :directory '(:relative :back "foo")
     
    10221086                 'error)
    10231087  t)
     1088
    10241089(deftest sbcl.41
    10251090  (check-merge-pathnames #p"scratch:absolute;path;name"
     
    10371102  (check-namestring (parse-namestring "/foo" (host-namestring #p"/bar")) "/foo")
    10381103  t)
     1104#+lispworks
     1105(pushnew 'sbcl.42 *expected-failures*)
     1106
    10391107(deftest sbcl.43
    10401108  (string= (namestring (parse-namestring "FOO" (host-namestring #p"SCRATCH:BAR")))
    10411109           "SCRATCH:FOO")
    10421110  t)
    1043 #-(or allegro clisp cmu)
     1111
     1112#-(or allegro clisp cmu lispworks)
    10441113(deftest sbcl.44
    10451114  ;; "The null string, "", is not a valid value for any component of a logical
     
    10711140  (check-readable-or-signals-error (make-pathname :name "foo" :type "txt" :version :newest))
    10721141  t)
     1142#+lispworks
     1143(pushnew 'sbcl.48 *expected-failures*)
    10731144
    10741145#-allegro
     
    10761147  (check-readable-or-signals-error (make-pathname :name "foo" :type "txt" :version 1))
    10771148  t)
    1078 
    1079 #-allegro
     1149#+lispworks
     1150(pushnew 'sbcl.49 *expected-failures*)
     1151
    10801152(deftest sbcl.50
    10811153  #-clisp
     
    10841156  (signals-error (make-pathname :name "foo" :type ".txt") 'error)
    10851157  t)
     1158#+(or allegro lispworks)
     1159(pushnew 'sbcl.50 *expected-failures*)
    10861160
    10871161(deftest sbcl.51
Note: See TracChangeset for help on using the changeset viewer.