Changeset 15399


Ignore:
Timestamp:
10/10/20 21:43:35 (3 years ago)
Author:
Mark Evenson
Message:

abcl/test/lisp: start towards correcting JAR-PATHNAME tests

Location:
trunk/abcl/test/lisp/abcl
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk/abcl/test/lisp/abcl/jar-pathname.lisp

    r15397 r15399  
    1 (in-package #:abcl.test.lisp)
     1(in-package #:abcl/test/lisp)
    22
    33(defparameter *tmp-directory* nil)
    … …  
    4848                                              (pathname-directory (pathname temp-file))
    4949                                              '("jar-pathname-tests")))))
    50     (jar-file-init temp-file temp-dir)))
    51 
    52 (defun jar-file-init (temp-file temp-dir)
     50    (jar-file-init temp-dir)))
     51
     52(defun jar-file-init (temp-dir)
    5353  "Create the jar archives used for testing.
    5454Returns the two values of the pathnames of the created archives."
    … …  
    119119     (unless (and *tmp-jar-path* (probe-file *tmp-jar-path*))
    120120       (create-jar))
    121      (let ((*default-pathname-defaults* *tmp-directory*))
     121     (let ((*default-pathname-defaults* *tmp-directory*)) ;; why do we need this?
    122122       ,@body)))
    123123
    124 (defun jar-pathname-escaped (jar path)
    125   (pathname (format nil "jar:file:~A!/~A"
    126                     (ext:uri-encode (namestring jar)) path)))
    127 
    128 (defmacro load-from-jar (jar path)
    129   `(with-jar-file-init
    130        (load (jar-pathname-escaped ,jar ,path))))
    131 
    132 ;;; XXX Figure out correct use of macros so this isn't necessary
    133 #|
    134 (push 'jar-pathname.load.init *expected-failures*)
    135 (deftest jar-pathname.load.init
    136     (with-jar-file-init
    137         nil)
    138   t)
    139 |#
     124(defun load-from-jar (jar entry)
     125  (let ((jar-pathname (if (ext:pathname-jar-p jar)
     126                          jar
     127                          (make-pathname :device (list jar)))))
     128    (load (merge-pathnames entry jar-pathname))))
    140129
    141130(deftest jar-pathname.load.1
    142     (load-from-jar *tmp-jar-path* "__loader__._")
    143   t)
    144 
     131  (with-jar-file-init
     132    (load-from-jar *tmp-jar-path* "__loader__._"))
     133  t)
     134
     135;; Needs nested jars implementation
     136(pushnew 'jar-pathname.load.2 *expected-failures*)
    145137(deftest jar-pathname.load.2
    146     (load-from-jar *tmp-jar-path* "bar")
    147   t)
    148 
     138  (with-jar-file-init
     139      (load-from-jar *tmp-jar-path* "bar"))
     140  t)
     141
     142;; Needs nested jars implementation
     143(pushnew 'jar-pathname.load.3 *expected-failures*)
    149144(deftest jar-pathname.load.3
    150     (load-from-jar *tmp-jar-path* "bar.abcl")
     145  (with-jar-file-init
     146    (load-from-jar *tmp-jar-path* "bar.abcl"))
    151147  t)
    152148
    153149(deftest jar-pathname.load.4
    154     (load-from-jar *tmp-jar-path* "eek")
     150  (with-jar-file-init
     151    (load-from-jar *tmp-jar-path* "eek"))
    155152  t)
    156153
    157154(deftest jar-pathname.load.5
    158     (load-from-jar *tmp-jar-path* "eek.lisp")
    159   t)
    160 
    161 #+(or)
     155  (with-jar-file-init
     156      (load-from-jar *tmp-jar-path* "eek.lisp"))
     157  t)
     158
    162159(deftest jar-pathname.load.6
    163     (load-from-jar *tmp-jar-path* "foo")
    164   t)
    165 
     160  (signals-error
     161   (load-from-jar *tmp-jar-path* "this doesn't exist")
     162   'file-error)
     163  t)
     164
     165;; Needs nested jars implementation
     166(pushnew 'jar-pathname.load.7 *expected-failures*)
    166167(deftest jar-pathname.load.7
    167     (load-from-jar *tmp-jar-path* "a/b/bar")
    168   t)
    169 
     168  (with-jar-file-init
     169      (load-from-jar *tmp-jar-path* "a/b/bar"))
     170  t)
     171
     172;; Needs nested jars implementation
     173(pushnew 'jar-pathname.load.8 *expected-failures*)
    170174(deftest jar-pathname.load.8
    171     (load-from-jar *tmp-jar-path* "a/b/bar.abcl")
     175  (with-jar-file-init
     176      (load-from-jar *tmp-jar-path* "a/b/bar.abcl"))
    172177  t)
    173178
    174179(deftest jar-pathname.load.9
    175     (load-from-jar *tmp-jar-path* "a/b/eek")
     180  (with-jar-file-init
     181      (load-from-jar *tmp-jar-path* "a/b/eek"))
    176182  t)
    177183
    178184(deftest jar-pathname.load.10
    179     (load-from-jar *tmp-jar-path* "a/b/eek.lisp")
    180   t)
    181 
     185  (with-jar-file-init
     186    (load-from-jar *tmp-jar-path* "a/b/eek.lisp"))
     187  t)
     188
     189;; Needs nested jars implementation
     190(pushnew 'jar-pathname.load.11 *expected-failures*)
    182191(deftest jar-pathname.load.11
    183     (load-from-jar *tmp-jar-path* "d/e+f/bar.abcl")
    184   t)
    185 
     192  (with-jar-file-init
     193      (load-from-jar *tmp-jar-path* "d/e+f/bar.abcl"))
     194  t)
     195
     196;; Needs nested jars implementation
     197(pushnew 'jar-pathname.load.12 *expected-failures*)
    186198(deftest jar-pathname.load.12
    187     (load-from-jar *tmp-jar-path* "a/b/foo%20bar.abcl")
    188   t)
    189 
     199  (with-jar-file-init
     200      (load-from-jar *tmp-jar-path* "a/b/foo%20bar.abcl"))
     201  t)
     202
     203;; Needs nested jars implementation
     204(pushnew 'jar-pathname.load.13 *expected-failures*)
    190205(deftest jar-pathname.load.13
    191     (signals-error
    192      (load-from-jar *tmp-jar-path* "a/b/foo bar.abcl")
    193      'error)
     206  (signals-error
     207   (load-from-jar *tmp-jar-path* "a/b/foo bar.abcl")
     208   'error)
    194209  t)
    195210
    … …  
    199214
    200215(deftest jar-pathname.load.15
    201     (signals-error
    202      (load-from-jar *tmp-jar-path-whitespace* "a/b/foo bar.abcl")
    203      'error)
    204   t)
    205 
     216  (signals-error
     217   (load-from-jar *tmp-jar-path-whitespace* "a/b/foo bar.abcl")
     218   'error)
     219  t)
     220
     221;; Needs nested jars implementation
     222(pushnew 'jar-pathname.load.16 *expected-failures*)
    206223(deftest jar-pathname.load.16
    207224    (load-from-jar *tmp-jar-path-whitespace* "a/b/foo%20bar.abcl")
    … …  
    209226
    210227(defparameter *url-jar-pathname-base*
    211   "jar:https://abcl.org/releases/1.7.1/abcl-bin-1.7.1.zip!/")
     228  #p"jar:https://abcl.org/releases/1.7.1/abcl-contrib.jar!/")
    212229
    213230(deftest jar-pathname.url.https.1
    214     (probe-file *url-jar-pathname-base*)
    215   *url-jar-pathname-base*)
     231  (equalp
     232   *url-jar-pathname-base*
     233   (probe-file *url-jar-pathname-base*))
     234  t)
    216235
    217236(deftest jar-pathname.probe-file.1
    218     (let ((result
    219            (with-jar-file-init
    220                (probe-file "jar:file:baz.jar!/eek.lisp"))))
    221       (string=
    222        (if result (namestring result) "")
    223        (format nil "jar:file:~Abaz.jar!/eek.lisp"
    224                (namestring *tmp-directory*))))
     237  (with-jar-file-init
     238      (let ((p
     239              (merge-pathnames "eek.lisp"
     240                               (make-pathname :device (list *tmp-jar-path*)))))
     241        (not (null (probe-file p)))))
    225242  t)
    226243
    227244(deftest jar-pathname.probe-file.2
    228     (let ((result
    229           (with-jar-file-init
    230               (probe-file "jar:file:baz.jar!/a/b/bar.abcl"))))
    231       (string=
    232        (if result (namestring result) "")
    233        (format nil "jar:file:~Abaz.jar!/a/b/bar.abcl"
    234                (namestring *tmp-directory*))))
    235   t)
    236 
     245  (with-jar-file-init
     246      (let ((p
     247              (merge-pathnames "a/b/bar.abcl"
     248                               (make-pathname :device (list *tmp-jar-path*)))))
     249        (not (null (probe-file p)))))
     250  t)
     251
     252#+(or) ;; needs nested pathnames
    237253(deftest jar-pathname.probe-file.3
    238254    (let ((result
    … …  
    245261  t)
    246262
    247 
    248 (push 'jar-pathname.probe-file.4 *expected-failures*)
    249263(deftest jar-pathname.probe-file.4
    250     (let ((result
    251           (with-jar-file-init
    252               (probe-file "jar:file:baz.jar!/a/b"))))
    253       (string=
    254        (if result (namestring result) "")
    255        (format nil "jar:file:~Abaz.jar!/a/b/"
    256                (namestring *tmp-directory*))))
    257   t)
    258 
    259 (push 'jar-pathname.probe-file.5 *expected-failures*)
     264    (with-jar-file-init
     265      (let ((p
     266              (merge-pathnames "a/b/bar.abcl"
     267                               (make-pathname :device (list *tmp-jar-path*)))))
     268        (not (null (probe-file p)))))
     269  t)
     270
    260271(deftest jar-pathname.probe-file.5
    261     (let ((result
    262           (with-jar-file-init
    263               (probe-file "jar:file:baz.jar!/a/b/"))))
    264       (string=
    265        (if result (namestring result) "")
    266        (format nil "jar:file:~Abaz.jar!/a/b/"
    267                (namestring *tmp-directory*))))
     272  (with-jar-file-init
     273      (let ((p
     274              (merge-pathnames "a/b/"
     275                               (make-pathname :device (list *tmp-jar-path*)))))
     276        (not (null (probe-file p)))))
    268277  t)
    269278
    270279
    271280(deftest jar-pathname.probe-file.6
    272     (let ((result
    273           (with-jar-file-init
    274               (probe-file "jar:file:baz.jar!/d/e+f/bar.abcl"))))
    275       (string=
    276        (if result (namestring result) "")
    277        (format nil "jar:file:~Abaz.jar!/d/e+f/bar.abcl"
    278                (namestring *tmp-directory*))))
    279   t)
     281  (with-jar-file-init
     282      (let ((p
     283              (merge-pathnames "d/e+f/bar.abcl/"
     284                               (make-pathname :device (list *tmp-jar-path*)))))
     285        (not (null (probe-file p)))))
     286  t)
     287
    280288
    281289(deftest jar-pathname.merge-pathnames.1
    282     (merge-pathnames
    283      "/bar.abcl" #p"jar:file:baz.jar!/foo")
    284   #p"jar:file:baz.jar!/bar.abcl")
     290  (merge-pathnames
     291   "/bar.abcl" #p"jar:file:/baz.jar!/foo")
     292  #p"jar:file:/baz.jar!/bar.abcl")
    285293
    286294(deftest jar-pathname.merge-pathnames.2
    287     (merge-pathnames
    288      "bar.abcl" #p"jar:file:baz.jar!/foo/baz")
    289   #p"jar:file:baz.jar!/foo/bar.abcl")
     295  (merge-pathnames
     296   "bar.abcl" #p"jar:file:/baz.jar!/foo/baz")
     297  #p"jar:file:/baz.jar!/foo/bar.abcl")
    290298
    291299(deftest jar-pathname.merge-pathnames.3
    292300    (merge-pathnames
    293      "jar:file:baz.jar!/foo" "bar")
    294   #p"jar:file:baz.jar!/foo")
     301     "jar:file:/baz.jar!/foo" "bar")
     302  #p"jar:file:/baz.jar!/foo")
    295303
    296304(deftest jar-pathname.merge-pathnames.4
    297305    (merge-pathnames
    298      "jar:file:baz.jar!/foo" "/a/b/c")
     306     "jar:file:/baz.jar!/foo" "/a/b/c")
    299307  #p"jar:file:/a/b/baz.jar!/foo")
    300 
    301308
    302309;;; Under win32, we get the device in the merged path
    303310#+windows
    304311(push 'jar-pathname.merge-pathnames.5 *expected-failures*)
    305 
    306312(deftest jar-pathname.merge-pathnames.5
    307     (merge-pathnames "jar:file:/a/b/c/foo.jar!/bar/baz.lisp")
     313  (merge-pathnames "jar:file:/a/b/c/foo.jar!/bar/baz.lisp")
    308314  #p"jar:file:/a/b/c/foo.jar!/bar/baz.lisp")
    309315
    310316(deftest jar-pathname.truename.1
    311     (signals-error (truename "jar:file:baz.jar!/foo")
    312                    'file-error)
     317  (signals-error (truename "jar:file:baz.jar!/foo")
     318                 'file-error)
    313319  t)
    314320
    315321(deftest jar-pathname.1
    316     (let* ((p #p"jar:file:foo/baz.jar!/")
     322    (let* ((p #p"jar:file:/foo/baz.jar!/")
    317323           (d (first (pathname-device p))))
    318324      (values
    319325       (pathname-directory d) (pathname-name d) (pathname-type d)))
    320   (:relative "foo") "baz" "jar")
     326  (:absolute "foo") "baz" "jar")
    321327
    322328(deftest jar-pathname.2
    … …  
    419425
    420426(deftest jar-pathname.11
    421     (let ((s (string-downcase "jar:file:/foo/bar/a%20space%3f/that!/this")))
     427    (let ((s (string-downcase "jar:file:///foo/bar/a%20space%3f/that!/this")))
    422428      (string= s
    423429               (string-downcase (namestring (pathname s)))))

  • trunk/abcl/test/lisp/abcl/package.lisp

    r15332 r15399  
    1 (defpackage #:abcl.test.lisp
     1(defpackage #:abcl/test/lisp
    22  (:use #:cl #:abcl-rt)
    3   (:nicknames "ABCL-TEST-LISP" "ABCL-TEST" "ABCL/TEST/LISP")
     3  (:nicknames #:abcl-test-lisp #:abcl-test #:abcl.test.lisp)
    44  (:export
    55   #:run
Note: See TracChangeset for help on using the changeset viewer.