Changeset 10062


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

    r10057 r10062  
    22;;;
    33;;; Copyright (C) 2005 Peter Graves
    4 ;;; $Id: pathname-tests.lisp,v 1.34 2005-09-28 15:30:39 piso Exp $
     4;;; $Id: pathname-tests.lisp,v 1.35 2005-09-28 18:55:23 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    127127            #-windows ,namestring))
    128128
     129;; Define a logical host.
     130(setf (logical-pathname-translations "effluvia")
     131      '(("**;*.*.*" "/usr/local/**/*.*")))
     132
    129133(deftest equal.1
    130134  (equal (make-pathname :name "foo" :type "bar")
     
    161165  #-sbcl nil)
    162166
     167;; "Parsing a null string always succeeds, producing a pathname with all
     168;; components (except the host) equal to nil."
    163169(deftest physical.1
     170  (check-physical-pathname #p"" nil nil nil)
     171  t)
     172
     173(deftest physical.2
    164174  (check-physical-pathname #p"/" '(:absolute) nil nil)
    165175  t)
    166 (deftest physical.2
     176(deftest physical.3
    167177  (check-physical-pathname #p"/foo" '(:absolute) "foo" nil)
    168178  t)
    169 (deftest physical.3
     179(deftest physical.4
    170180  #-lispworks
    171181  (check-physical-pathname #p"/foo." '(:absolute) "foo" "")
     
    173183  (check-physical-pathname #p"/foo." '(:absolute) "foo." nil)
    174184  t)
    175 (deftest physical.4
    176   (check-physical-pathname #p"/foo.b" '(:absolute) "foo" "b")
    177   t)
    178185(deftest physical.5
     186  (check-physical-pathname #p"/foo.bar" '(:absolute) "foo" "bar")
     187  t)
     188(deftest physical.6
    179189  #-lispworks
    180190  (check-physical-pathname #p"/foo.bar." '(:absolute) "foo.bar" "")
     
    182192  (check-physical-pathname #p"/foo.bar." '(:absolute) "foo.bar." nil)
    183193  t)
    184 (deftest physical.6
     194(deftest physical.7
    185195  (check-physical-pathname #p"/foo.bar.baz" '(:absolute) "foo.bar" "baz")
    186196  t)
    187 (deftest physical.7
     197(deftest physical.8
    188198  (check-physical-pathname #p"/foo/bar" '(:absolute "foo") "bar" nil)
    189199  t)
    190 (deftest physical.8
     200(deftest physical.9
    191201  (check-physical-pathname #p"/foo..bar" '(:absolute) "foo." "bar")
    192202  t)
    193 (deftest physical.9
     203(deftest physical.10
    194204  (check-physical-pathname #p"foo.bar" nil "foo" "bar")
    195205  t)
    196 (deftest physical.10
     206(deftest physical.11
    197207  (check-physical-pathname #p"foo.bar.baz" nil "foo.bar" "baz")
    198208  t)
    199 (deftest physical.11
     209(deftest physical.12
    200210  (check-physical-pathname #p"foo/" '(:relative "foo") nil nil)
    201211  t)
    202 (deftest physical.12
     212(deftest physical.13
    203213  (check-physical-pathname #p"foo/bar" '(:relative "foo") "bar" nil)
    204214  t)
    205 (deftest physical.13
     215(deftest physical.14
    206216  (check-physical-pathname #p"foo/bar/baz" '(:relative "foo" "bar") "baz" nil)
    207217  t)
    208 (deftest physical.14
     218(deftest physical.15
    209219  (check-physical-pathname #p"foo/bar/" '(:relative "foo" "bar") nil nil)
    210220  t)
    211221#+allegro
    212 (deftest physical.15
     222(deftest physical.16
    213223  ;; This reduction is wrong.
    214224  (check-physical-pathname #p"foo/bar/.." '(:relative "foo") nil nil)
    215225  t)
    216226#+allegro
    217 (deftest physical.16
     227(deftest physical.17
    218228  (check-physical-pathname #p"/foo/../" '(:absolute) nil nil)
    219229  t)
    220 (deftest physical.17
     230(deftest physical.18
    221231  #-lispworks
    222232  (check-physical-pathname #p".lisprc" nil ".lisprc" nil)
     
    224234  (check-physical-pathname #p".lisprc" nil "" "lisprc")
    225235  t)
    226 (deftest physical.18
     236(deftest physical.19
    227237  (check-physical-pathname #p"x.lisprc" nil "x" "lisprc")
    228238  t)
    229239
    230 (deftest physical.19
     240(deftest physical.20
    231241  #-allegro
    232242  (check-physical-pathname (make-pathname :name ".") nil "." nil)
     
    235245  t)
    236246
    237 (deftest physical.20
     247(deftest physical.21
    238248  #-cmu
    239249  (check-readable (make-pathname :name "."))
     
    242252  t)
    243253#+lispworks
    244 (pushnew 'physical.20 *expected-failures*)
     254(pushnew 'physical.21 *expected-failures*)
    245255
    246256;; #p"."
    247 (deftest physical.21
     257(deftest physical.22
    248258  #+(or allegro abcl cmu)
    249259  (check-physical-pathname #p"." '(:relative) nil nil)
     
    253263  t)
    254264#+(or cmu lispworks)
    255 (pushnew 'physical.21 *expected-failures*)
    256 
    257 (deftest physical.22
     265(pushnew 'physical.22 *expected-failures*)
     266
     267(deftest physical.23
    258268  (equal #p"." #p"")
    259269  nil)
    260270#+lispworks
    261 (pushnew 'physical.22 *expected-failures*)
     271(pushnew 'physical.23 *expected-failures*)
    262272
    263273;; #p"./"
    264274;; Trailing separator character means it's a directory.
    265 (deftest physical.23
     275(deftest physical.24
    266276  #+(or allegro abcl clisp cmu)
    267277  (check-physical-pathname #p"./" '(:relative) nil nil)
     
    271281  t)
    272282#+(or cmu lispworks)
    273 (pushnew 'physical.23 *expected-failures*)
    274 
    275 (deftest physical.24
     283(pushnew 'physical.24 *expected-failures*)
     284
     285(deftest physical.25
    276286  (equal #p"./" #p"")
    277287  nil)
    278288#+lispworks
    279 (pushnew 'physical.24 *expected-failures*)
    280 
    281 
    282 (deftest physical.25
     289(pushnew 'physical.25 *expected-failures*)
     290
     291
     292(deftest physical.26
    283293  #-allegro
    284294  (check-physical-pathname (make-pathname :name "..") nil ".." nil)
     
    288298
    289299#-(or sbcl)
    290 (deftest physical.26
     300(deftest physical.27
    291301  #-cmu
    292302  (check-readable (make-pathname :name ".."))
     
    295305  t)
    296306#+(or clisp lispworks)
    297 (pushnew 'physical.26 *expected-failures*)
     307(pushnew 'physical.27 *expected-failures*)
    298308
    299309;; #p".."
    300 (deftest physical.27
     310(deftest physical.28
    301311  #+(or allegro)
    302312  (check-physical-pathname #p".." '(:relative :back) nil nil)
     
    314324  t)
    315325#+cmu
    316 (pushnew 'physical.27 *expected-failures*)
     326(pushnew 'physical.28 *expected-failures*)
    317327
    318328;; #p"../"
    319 (deftest physical.28
     329(deftest physical.29
    320330  #+allegro
    321331  (check-physical-pathname #p"../" '(:relative :back) nil nil)
    322332  #+(or abcl sbcl cmu clisp lispworks)
    323333  (check-physical-pathname #p"../" '(:relative :up) nil nil)
     334  t)
     335
     336#-sbcl
     337(deftest physical.30
     338  #-(or allegro cmu)
     339  (string= (namestring (make-pathname :name "..")) "..")
     340  #+allegro
     341  (string= (namestring (make-pathname :name "..")) "../")
     342  #+cmu (signals-error (namestring (make-pathname :name "..")) 'error)
     343  t)
     344
     345(deftest physical.31
     346  (string= (namestring (make-pathname :directory '(:relative :up)))
     347           #+windows "..\\"
     348           #-windows "../")
     349  t)
     350
     351(deftest wild.1
     352  (check-physical-pathname #p"foo.*" nil "foo" :wild)
     353  t)
     354
     355(deftest wild.2
     356  (check-physical-pathname #p"*.*" nil :wild :wild)
    324357  t)
    325358
     
    337370#+cmu
    338371(pushnew 'lots-of-dots.2 *expected-failures*)
    339 
    340 (deftest physical.29
    341   (check-physical-pathname #p"foo.*" nil "foo" :wild)
    342   t)
    343 
    344 #-sbcl
    345 (deftest physical.30
    346   #-(or allegro cmu)
    347   (string= (namestring (make-pathname :name "..")) "..")
    348   #+allegro
    349   (string= (namestring (make-pathname :name "..")) "../")
    350   #+cmu (signals-error (namestring (make-pathname :name "..")) 'error)
    351   t)
    352 
    353 (deftest physical.31
    354   (string= (namestring (make-pathname :directory '(:relative :up)))
    355            #+windows "..\\"
    356            #-windows "../")
    357   t)
    358372
    359373;; Silly names.
     
    367381#+(or cmu lispworks)
    368382(pushnew 'silly.1 *expected-failures*)
    369 
    370 ;; If the prefix isn't a defined logical host, it's not a logical pathname.
    371 #-cmu
    372 ;; CMUCL parses this as (:ABSOLUTE #<SEARCH-LIST foo>) "bar.baz" "42".
    373 (deftest logical.1
    374   #+allegro
    375   ;; Except in Allegro.
    376   (check-logical-pathname #p"foo:bar.baz.42" "foo" nil "bar" "baz" nil)
    377   #-allegro
    378   (check-physical-pathname #p"foo:bar.baz.42" nil "foo:bar.baz" "42")
    379   t)
    380 #+lispworks
    381 (pushnew 'logical.1 *expected-failures*)
    382 
    383 ;; Define a logical host.
    384 (setf (logical-pathname-translations "effluvia")
    385       '(("**;*.*.*" "/usr/local/**/*.*")))
    386383
    387384;; LOGICAL-PATHNAME-TRANSLATIONS
     
    399396  t)
    400397
     398;; "The null string, "", is not a valid value for any component of a logical
     399;; pathname." 19.3.2.2
     400(deftest logical-pathname.1
     401  #-clisp
     402  (signals-error (logical-pathname ":") 'error)
     403  #+clisp
     404  (check-logical-pathname (logical-pathname ":") "" '(:absolute) nil nil nil)
     405  t)
     406
     407;; Parse error.
     408(deftest logical-pathname.2
     409  (signals-error (logical-pathname "effluvia::foo.bar")
     410                 #-(or allegro clisp) 'parse-error
     411                 #+(or allegro clisp) 'type-error)
     412  t)
     413
     414;; If the prefix isn't a defined logical host, it's not a logical pathname.
     415#-cmu
     416;; CMUCL parses this as (:ABSOLUTE #<SEARCH-LIST foo>) "bar.baz" "42".
     417(deftest logical.1
     418  #+allegro
     419  ;; Except in Allegro.
     420  (check-logical-pathname #p"foo:bar.baz.42" "foo" nil "bar" "baz" nil)
     421  #-allegro
     422  (check-physical-pathname #p"foo:bar.baz.42" nil "foo:bar.baz" "42")
     423  t)
     424#+lispworks
     425(pushnew 'logical.1 *expected-failures*)
     426
    401427#+sbcl
    402 (deftest physical.32
     428(deftest logical.2
    403429  ;; Even though "effluvia" is defined as a logical host, "bop" is not a valid
    404430  ;; logical pathname version, so this can't be a logical pathname.
     
    406432  t)
    407433
    408 ;; Parse error.
    409 (deftest logical-pathname.1
    410   (signals-error (logical-pathname "effluvia::foo.bar")
    411                  #-(or allegro clisp) 'parse-error
    412                  #+(or allegro clisp) 'type-error)
     434(deftest logical.3
     435  #-allegro
     436  (check-logical-pathname (make-pathname :defaults "effluvia:foo.lisp")
     437                          "EFFLUVIA" '(:absolute) "FOO" "LISP" nil)
     438  #+allegro
     439  (check-logical-pathname (make-pathname :defaults "effluvia:foo.lisp")
     440                          "effluvia" nil "foo" "lisp" nil)
    413441  t)
    414442
    415443#-allegro
    416 (deftest logical.2
     444(deftest logical.4
    417445  (check-logical-pathname #p"effluvia:bar.baz.42" "EFFLUVIA" '(:absolute) "BAR" "BAZ" 42)
    418446  t)
    419447#-allegro
    420 (deftest logical.3
     448(deftest logical.5
    421449  (string= (write-to-string #p"effluvia:bar.baz.42" :escape t)
    422450           "#P\"EFFLUVIA:BAR.BAZ.42\"")
     
    426454;; Allegro returns NIL for the device and directory and drops the version
    427455;; entirely (even from the namestring).
    428 (deftest logical.4
     456(deftest logical.6
    429457  (check-logical-pathname #p"effluvia:bar.baz.42" "effluvia" nil "bar" "baz" nil)
    430458  t)
    431459
    432460#+allegro
    433 (deftest logical.5
     461(deftest logical.7
    434462  (string= (write-to-string #p"effluvia:bar.baz" :escape t)
    435463           #+allegro-v6.2 "#p\"effluvia:bar.baz\""
     
    437465  t)
    438466
    439 (deftest logical.6
     467(deftest logical.8
    440468  (typep (parse-namestring "**;*.*.*" "effluvia") 'logical-pathname)
    441469  t)
    442470
    443 (deftest logical.7
     471(deftest logical.9
    444472  (check-namestring (parse-namestring "**;*.*.*" "effluvia")
    445473                    #-(or allegro lispworks)
     
    454482#-allegro
    455483;; The version can be a bignum.
    456 (deftest logical.8
     484(deftest logical.10
    457485  (check-logical-pathname #p"effluvia:bar.baz.2147483648" "EFFLUVIA" '(:absolute) "BAR" "BAZ" 2147483648)
    458486  t)
    459 #-(or sbcl allegro)
     487
     488#-allegro
     489(deftest logical.11
     490  (check-namestring #p"effluvia:bar.baz.2147483648" "EFFLUVIA:BAR.BAZ.2147483648")
     491  t)
     492#+sbcl
    460493;; SBCL has a bug when the version is a bignum.
    461 (deftest logical.9
    462   (check-namestring #p"effluvia:bar.baz.2147483648" "EFFLUVIA:BAR.BAZ.2147483648")
    463   t)
    464 
    465 (deftest logical.10
     494(pushnew 'logical.11 *expected-failures*)
     495
     496(deftest logical.12
     497  (check-namestring #p"effluvia:foo.bar.newest"
     498                    #-(or allegro cmu) "EFFLUVIA:FOO.BAR.NEWEST"
     499                    #+allegro "effluvia:foo.bar"
     500                    #+cmu "EFFLUVIA:FOO.BAR")
     501  t)
     502
     503(deftest logical.13
    466504  #-allegro
    467505  (check-logical-pathname #p"effluvia:foo.*" "EFFLUVIA" '(:absolute) "FOO" :wild nil)
     
    470508  t)
    471509
    472 (deftest logical.11
     510(deftest logical.14
    473511  #-allegro
    474512  (check-logical-pathname #p"effluvia:*.lisp" "EFFLUVIA" '(:absolute) :wild "LISP" nil)
     
    477515  t)
    478516
    479 (deftest logical.12
     517(deftest logical.15
    480518  #-allegro
    481519  (check-logical-pathname #p"effluvia:bar.baz.newest" "EFFLUVIA" '(:absolute) "BAR" "BAZ" :newest)
     
    484522  t)
    485523
    486 (deftest logical.13
     524(deftest logical.16
    487525  #-allegro
    488526  (check-logical-pathname #p"EFFLUVIA:BAR.BAZ.NEWEST" "EFFLUVIA" '(:absolute) "BAR" "BAZ" :newest)
     
    492530
    493531;; The directory component.
    494 (deftest logical.14
     532(deftest logical.17
    495533  (check-logical-pathname #p"effluvia:foo;bar.baz" "EFFLUVIA" '(:absolute "FOO") "BAR" "BAZ" nil)
    496534  t)
    497535
    498 (deftest logical.15
     536(deftest logical.18
    499537  (check-namestring #p"effluvia:foo;bar.baz"
    500538                    #-allegro "EFFLUVIA:FOO;BAR.BAZ"
     
    502540  t)
    503541
    504 (deftest logical.16
     542(deftest logical.19
    505543  #-allegro
    506544  (check-logical-pathname #p"effluvia:;bar.baz" "EFFLUVIA" '(:relative) "BAR" "BAZ" nil)
     
    510548  (check-logical-pathname #p"effluvia:;bar.baz" "EFFLUVIA" nil "BAR" "BAZ" nil)
    511549  t)
    512 (deftest logical.17
     550(deftest logical.20
    513551  (check-namestring #p"effluvia:;bar.baz"
    514552                    #+allegro "effluvia:bar.baz"
     
    519557;; component parsed is as relative; otherwise, the directory component is
    520558;; parsed as absolute."
    521 (deftest logical.18
     559(deftest logical.21
    522560  (equal (pathname-directory #p"effluvia:foo.baz")
    523561         #-allegro '(:absolute)
     
    525563  t)
    526564
    527 (deftest logical.19
     565(deftest logical.22
    528566  (typep  #p"effluvia:" 'logical-pathname)
    529567  t)
    530568
    531 (deftest logical.20
     569(deftest logical.23
    532570  (equal (pathname-directory #p"effluvia:")
    533571         #-allegro '(:absolute)
     
    765803  t)
    766804
     805(deftest merge-pathnames.2
     806  (equal (merge-pathnames (logical-pathname "effluvia:;foo;bar;")
     807                          (logical-pathname "effluvia:baz;quux.lisp.3"))
     808         #-allegro
     809         (make-pathname :host "EFFLUVIA"
     810                        :device :unspecific
     811                        :directory '(:absolute "BAZ" "FOO" "BAR")
     812                        :name "QUUX"
     813                        :type "LISP"
     814                        :version 3)
     815         #+allegro
     816         (make-pathname :host "effluvia"
     817                        :device nil
     818                        :directory '(:absolute "baz" "foo" "bar")
     819                        :name "quux"
     820                        :type "lisp"
     821                        :version nil)
     822         )
     823  t)
     824
     825(deftest compile-file-pathname.1
     826  (equal (compile-file-pathname "effluvia:foo.lisp")
     827         #+abcl
     828         ;; Is this a bug? (Should version be :NEWEST?)
     829         #p"EFFLUVIA:FOO.ABCL"
     830         #+allegro #p"effluvia:foo.fasl"
     831         #+(or cmu sbcl) #p"EFFLUVIA:FOO.FASL.NEWEST"
     832         #+clisp
     833         ;; Is this a bug?
     834         ;; #p"EFFLUVIA:FOO.fas.NEWEST"
     835         (make-pathname :host "EFFLUVIA" :directory '(:absolute)
     836                        :name "FOO" :type "fas" :version :newest)
     837         #+lispworks #p"EFFLUVIA:FOO.USFL.NEWEST"
     838         )
     839  t)
     840
    767841;; The following tests are adapted from SBCL's pathnames.impure.lisp.
    768842(setf (logical-pathname-translations "demo0")
     
    916990                    "/library/foo/foo/bar/baz/mum.quux")
    917991  t)
    918 ;; (setf (logical-pathname-translations "prog")
    919 ;;       '(("RELEASED;*.*.*"        "MY-UNIX:/sys/bin/my-prog/")
    920 ;;         ("RELEASED;*;*.*.*"      "MY-UNIX:/sys/bin/my-prog/*/")
    921 ;;         ("EXPERIMENTAL;*.*.*"    "MY-UNIX:/usr/Joe/development/prog/")
    922 ;;         ("EXPERIMENTAL;*;*.*.*"  "MY-UNIX:/usr/Joe/development/prog/*/")))
     992
    923993(setf (logical-pathname-translations "prog")
    924994      '(("CODE;*.*.*"             "/lib/prog/")))
Note: See TracChangeset for help on using the changeset viewer.