Changeset 10097


Ignore:
Timestamp:
10/13/05 16:59:16 (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

    r10095 r10097  
    22;;;
    33;;; Copyright (C) 2005 Peter Graves
    4 ;;; $Id: pathname-tests.lisp,v 1.45 2005-10-12 18:40:22 piso Exp $
     4;;; $Id: pathname-tests.lisp,v 1.46 2005-10-13 16:59:16 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    202202  (check-physical-pathname #p"/" '(:absolute) nil nil)
    203203  t)
     204
    204205(deftest physical.3
    205206  (check-physical-pathname #p"/foo" '(:absolute) "foo" nil)
    206207  t)
     208
    207209(deftest physical.4
    208210  #-lispworks
     
    211213  (check-physical-pathname #p"/foo." '(:absolute) "foo." nil)
    212214  t)
     215
    213216(deftest physical.5
    214217  (check-physical-pathname #p"/foo.bar" '(:absolute) "foo" "bar")
    215218  t)
     219
    216220(deftest physical.6
    217221  #-lispworks
     
    220224  (check-physical-pathname #p"/foo.bar." '(:absolute) "foo.bar." nil)
    221225  t)
     226
    222227(deftest physical.7
    223228  (check-physical-pathname #p"/foo.bar.baz" '(:absolute) "foo.bar" "baz")
    224229  t)
     230
    225231(deftest physical.8
    226232  (check-physical-pathname #p"/foo/bar" '(:absolute "foo") "bar" nil)
    227233  t)
     234
    228235(deftest physical.9
    229236  (check-physical-pathname #p"/foo..bar" '(:absolute) "foo." "bar")
    230237  t)
     238
    231239(deftest physical.10
    232240  (check-physical-pathname #p"foo.bar" nil "foo" "bar")
    233241  t)
     242
    234243(deftest physical.11
    235244  (check-physical-pathname #p"foo.bar.baz" nil "foo.bar" "baz")
    236245  t)
     246
    237247(deftest physical.12
    238248  (check-physical-pathname #p"foo/" '(:relative "foo") nil nil)
    239249  t)
     250
    240251(deftest physical.13
    241252  (check-physical-pathname #p"foo/bar" '(:relative "foo") "bar" nil)
    242253  t)
     254
    243255(deftest physical.14
    244256  (check-physical-pathname #p"foo/bar/baz" '(:relative "foo" "bar") "baz" nil)
    245257  t)
     258
    246259(deftest physical.15
    247260  (check-physical-pathname #p"foo/bar/" '(:relative "foo" "bar") nil nil)
    248261  t)
     262
    249263#+allegro
    250264(deftest physical.16
     
    252266  (check-physical-pathname #p"foo/bar/.." '(:relative "foo") nil nil)
    253267  t)
     268
    254269#+allegro
    255270(deftest physical.17
    256271  (check-physical-pathname #p"/foo/../" '(:absolute) nil nil)
    257272  t)
     273
    258274(deftest physical.18
    259275  #-lispworks
     
    262278  (check-physical-pathname #p".lisprc" nil "" "lisprc")
    263279  t)
     280
    264281(deftest physical.19
    265282  (check-physical-pathname #p"x.lisprc" nil "x" "lisprc")
     
    452469#+cmu
    453470(pushnew 'lots-of-dots.1 *expected-failures*)
     471
    454472#+(or allegro abcl cmu)
    455473(deftest lots-of-dots.2
     
    535553  (check-logical-pathname #p"effluvia:bar.baz.42" "EFFLUVIA" '(:absolute) "BAR" "BAZ" 42)
    536554  t)
     555
    537556#-allegro
    538557(deftest logical.5
     
    637656  (check-logical-pathname #p"effluvia:;bar.baz" "EFFLUVIA" nil "BAR" "BAZ" nil)
    638657  t)
     658
    639659(deftest logical.20
    640660  (check-namestring #p"effluvia:;bar.baz"
     
    764784  (pathname-match-p "/foo/bar/baz" "/*/*/baz")
    765785  t)
     786
    766787(deftest pathname-match-p.2
    767788  (pathname-match-p "/foo/bar/baz" "/**/baz")
    768789  t)
     790
    769791(deftest pathname-match-p.3
    770792  (pathname-match-p "/foo/bar/quux/baz" "/**/baz")
    771793  t)
     794
    772795(deftest pathname-match-p.4
    773796  (pathname-match-p "foo.bar" "/**/*.*")
    774797  t)
     798
    775799(deftest pathname-match-p.5
    776800  (pathname-match-p "/usr/local/bin/foo.bar" "/**/foo.bar")
    777801  t)
     802
    778803(deftest pathname-match-p.6
    779804  (pathname-match-p "/usr/local/bin/foo.bar" "**/foo.bar")
    780805  nil)
     806
    781807(deftest pathname-match-p.7
    782808  (pathname-match-p "/foo/bar.txt" "/**/*.*")
    783809  t)
     810
    784811(deftest pathname-match-p.8
    785812  (pathname-match-p "/foo/bar.txt" "**/*.*")
    786813  nil)
     814
    787815(deftest pathname-match-p.9
    788816  (pathname-match-p #p"effluvia:foo.bar" #p"effluvia:**;*.*.*")
    789817  t)
    790818
     819(deftest pathname-match-p.10
     820  (pathname-match-p "foo" "foo.*")
     821  t)
     822
    791823;; TRANSLATE-PATHNAME
    792 #-clisp
    793824(deftest translate-pathname.1
     825  #-clisp
    794826  (equal (translate-pathname "foo" "*" "bar") #p"bar")
    795   t)
     827  #+clisp
     828  (signals-error (translate-pathname "foo" "*" "bar") 'error)
     829  t)
     830
    796831(deftest translate-pathname.2
    797832  (equal (translate-pathname "foo" "*" "*")   #p"foo")
    798833  t)
    799834
    800 ;; ABCL doesn't implement this translation.
    801835(deftest translate-pathname.3
    802836  #-abcl
     
    805839           #+allegro-v7.0 "foo*")
    806840  #+abcl
     841  ;; ABCL doesn't implement this translation. Verify that it signals an error.
    807842  (signals-error (translate-pathname "foobar" "*" "foo*") 'error)
    808843  t)
    809844
    810 ;; ABCL doesn't implement this translation.
    811845(deftest translate-pathname.4
    812846  #-abcl
     
    815849         #+allegro-v7.0 #p"*baz")
    816850  #+abcl
     851  ;; ABCL doesn't implement this translation. Verify that it signals an error.
    817852  (signals-error (translate-pathname "foobar" "foo*" "*baz") 'error)
    818853  t)
    819854
    820 ;; ABCL doesn't implement this translation.
    821855(deftest translate-pathname.5
    822856  #-abcl
     
    825859         #+(or cmu sbcl lispworks) #p"foobar")
    826860  #+abcl
     861  ;; ABCL doesn't implement this translation. Verify that it signals an error.
    827862  (signals-error (translate-pathname "foobar" "foo*" "") 'error)
    828863  t)
     
    886921  (pathname-match-p "/foo/bar.txt" "**/*.*")
    887922  nil)
     923
    888924;; Since (pathname-match-p "/foo/bar.txt" "**/*.*" ) => NIL...
    889925(deftest translate-pathname.18
     
    900936  (pathname-match-p "/foo/bar.txt" "/**/*.*")
    901937  t)
     938
    902939(deftest translate-pathname.19
    903940  (equal (translate-pathname "/foo/bar.txt" "/**/*.*" "/usr/local/**/*.*")
     
    10081045  t)
    10091046
     1047(deftest file-namestring.1
     1048  (equal (file-namestring #p"")
     1049         #+(or abcl allegro cmu)
     1050         nil
     1051         #+(or clisp lispworks sbcl)
     1052         "")
     1053  t)
     1054
     1055(deftest file-namestring.2
     1056  (equal (file-namestring #p"foo") "foo")
     1057  t)
     1058
     1059(deftest file-namestring.3
     1060  (let ((pathname (make-pathname :type "foo")))
     1061    #+abcl
     1062    (equal (file-namestring pathname) nil)
     1063    #+allegro
     1064    (equal (file-namestring pathname) "NIL.foo") ;; bug
     1065    #+(or clisp lispworks)
     1066    (equal (file-namestring pathname) ".foo")
     1067    #+(or cmu sbcl)
     1068    (signals-error (file-namestring pathname) 'error))
     1069  t)
     1070
     1071;; A variant of FILE-NAMESTRING.3 that detects Allegro's bug as a bug.
     1072(deftest file-namestring.4
     1073  (let ((pathname (make-pathname :type "foo")))
     1074    #-(or cmu sbcl)
     1075    (not (equal (file-namestring pathname) "NIL.foo"))
     1076    #+(or cmu sbcl)
     1077    (signals-error (file-namestring pathname) 'error))
     1078  t)
     1079#+allegro
     1080(pushnew 'file-namestring.4 *expected-failures*)
     1081
    10101082(deftest enough-namestring.1
    10111083  (equal (enough-namestring #p"/foo" #p"/") "foo")
     
    10711143(deftest sbcl.8
    10721144  (check-namestring (translate-logical-pathname "demo1:;foo.lisp")
    1073 ;;                     #+(and abcl windows) "\\tmp\\rel\\foo.lisp"
    1074 ;;                     #+(and abcl unix) "/tmp/rel/foo.lisp"
    1075 ;;                     #+(and allegro unix) "/tmp/foo.lisp"
    1076 ;;                     #+(and allegro windows) "\\tmp\\foo.lisp"
    1077 ;;                     #-(or allegro abcl) "/tmp/rel/foo.lisp"
    10781145                    #+abcl "/tmp/rel/foo.lisp"
    10791146                    #+allegro "/tmp/foo.lisp"
    1080                     #-(or allegro abcl) "/tmp/rel/foo.lisp"
    1081                     )
     1147                    #-(or allegro abcl) "/tmp/rel/foo.lisp")
    10821148  t)
    10831149
     
    11421208(setf (logical-pathname-translations "bazooka")
    11431209      '(("todemo;*.*.*" "demo0:*.*.*")))
     1210
    11441211(deftest sbcl.17
    11451212  #+allegro ;; BUG
     
    11591226         #+windows "\\tmp\\x.y")
    11601227  t)
     1228
    11611229#-(or allegro clisp)
    11621230(deftest sbcl.19
     
    11871255(setf (logical-pathname-translations "test0")
    11881256      '(("**;*.*.*"              "/library/foo/**/")))
     1257
    11891258(deftest sbcl.23
    11901259  (check-namestring (translate-logical-pathname "test0:foo;bar;baz;mum.quux")
     
    11941263(setf (logical-pathname-translations "prog")
    11951264      '(("CODE;*.*.*"             "/lib/prog/")))
     1265
    11961266#-allegro
    11971267(deftest sbcl.24
     
    11991269                    "/lib/prog/documentation.lisp")
    12001270  t)
     1271
    12011272(setf (logical-pathname-translations "prog1")
    12021273      '(("CODE;DOCUMENTATION.*.*" "/lib/prog/docum.*")
    12031274        ("CODE;*.*.*"             "/lib/prog/")))
     1275
    12041276#-allegro
    12051277(deftest sbcl.25
     
    12371309                         #p"/supplied-dir/name.type")
    12381310  t)
     1311
    12391312;; 2) no directory, no type
    12401313(deftest sbcl.29
     
    12421315                         #p"/dir/supplied-name.type")
    12431316  t)
     1317
    12441318;; 3) no name, no dir (must use make-pathname as ".foo" is parsed
    12451319;; as a name)
     
    12491323                         #p"/dir/name.supplied-type")
    12501324  t)
     1325
    12511326;; If (pathname-directory pathname) is a list whose car is
    12521327;; :relative, and (pathname-directory default-pathname) is a
     
    12561331                         #p"/aaa/bbb/ccc/ddd/qqq/www")
    12571332  t)
     1333
    12581334;; except that if the resulting list contains a string or
    12591335;; :wild immediately followed by :back, both of them are
     
    12651341   #p"/aaa/bbb/ccc/ddd/eee" #P"/aaa/bbb/ccc/blah/eee")
    12661342  t)
     1343
    12671344;; If (pathname-directory default-pathname) is not a list or
    12681345;; (pathname-directory pathname) is not a list whose car is
     
    12731350                         #P"/absolute/path/name.type")
    12741351  t)
     1352
    12751353(deftest sbcl.34
    12761354  (check-merge-pathnames #p"scratch:;name2" #p"scratch:foo;"
Note: See TracChangeset for help on using the changeset viewer.