Changeset 13057


Ignore:
Timestamp:
11/27/10 11:03:58 (11 years ago)
Author:
Mark Evenson
Message:

Tests for the implementation of URI encoding.

Restructured test package by factoring commonly used routines into the
newly created 'utilities.lisp'.

Start marking tests that are known failures.

Location:
trunk/abcl
Files:
1 added
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/abcl.asd

    r13010 r13057  
    2525;;; could be possibly be done at finer granularity in the files
    2626;;; themselves.
    27 (defsystem :abcl-test-lisp :version "1.1" :components
     27(defsystem :abcl-test-lisp :version "1.2" :components
    2828     ((:module abcl-rt
    2929                     :pathname "test/lisp/abcl/" :serial t :components
    30          ((:file "rt-package") (:file "rt")
     30         ((:file "rt-package")
     31                      (:file "rt")
    3132                      (:file "test-utilities")))
    3233      (:module package  :depends-on (abcl-rt)
     
    3536            (:module test :depends-on (package)
    3637         :pathname "test/lisp/abcl/" :components
    37                      ((:file "compiler-tests")
     38                     ((:file "utilities")
     39                      (:file "compiler-tests")
    3840                      (:file "condition-tests")
    3941                      #+abcl
     
    4850                      #+abcl
    4951                      (:file "jar-pathname" :depends-on
    50                              ("pathname-tests"))
     52                             ("utilities" "pathname-tests" "file-system-tests"))
    5153                      #+abcl
    5254                      (:file "url-pathname")
     
    5860                      (:file "wild-pathnames" :depends-on ("file-system-tests"))
    5961                      #+abcl
    60                       (:file "pathname-tests")))))
     62                      (:file "pathname-tests" :depends-on ("utilities"))))))
    6163
    6264(defmethod perform ((o test-op) (c (eql (find-system 'abcl-test-lisp))))
  • trunk/abcl/test/lisp/abcl/jar-pathname.lisp

    r13026 r13057  
    22
    33(defvar *jar-file-init* nil)
    4 
    5 ;;; From CL-FAD
    6 (defvar *stream-buffer-size* 8192)
    7 (defun cl-fad-copy-stream (from to &optional (checkp t))
    8   "Copies into TO \(a stream) from FROM \(also a stream) until the end
    9 of FROM is reached, in blocks of *stream-buffer-size*.  The streams
    10 should have the same element type.  If CHECKP is true, the streams are
    11 checked for compatibility of their types."
    12   (when checkp
    13     (unless (subtypep (stream-element-type to) (stream-element-type from))
    14       (error "Incompatible streams ~A and ~A." from to)))
    15   (let ((buf (make-array *stream-buffer-size*
    16                          :element-type (stream-element-type from))))
    17     (loop
    18      (let ((pos (read-sequence buf from)))
    19        (when (zerop pos) (return))
    20        (write-sequence buf to :end pos))))
    21   (values))
    22 
    23 (defun cl-fad-copy-file (from to &key overwrite)
    24   "Copies the file designated by the non-wild pathname designator FROM
    25 to the file designated by the non-wild pathname designator TO.  If
    26 OVERWRITE is true overwrites the file designtated by TO if it exists."
    27   (let ((element-type '(unsigned-byte 8)))
    28     (with-open-file (in from :element-type element-type)
    29       (with-open-file (out to :element-type element-type
    30                               :direction :output
    31                               :if-exists (if overwrite
    32                                            :supersede :error))
    33         (cl-fad-copy-stream in out))))
    34   (values))
    354
    365(defun jar-file-init ()
     
    198167                       (namestring *abcl-test-directory*)))
    199168
     169(push 'jar-pathname.probe-file.4 *expected-failures*)
    200170(deftest jar-pathname.probe-file.4
    201171    (with-jar-file-init
     
    204174                       (namestring *abcl-test-directory*)))
    205175
     176(push 'jar-pathname.probe-file.5 *expected-failures*)
    206177(deftest jar-pathname.probe-file.5
    207178    (with-jar-file-init
     
    342313  (:absolute "c" "d") "foo" "lisp")
    343314
     315;;; 'jar:file:' forms must be URI encoded, meaning whitespace is not allowed
    344316(deftest jar-pathname.10
    345     (let ((s "jar:file:/foo/bar/a space/that!/this"))
    346       (equal s
     317    (signals-error
     318     (let ((s "jar:file:/foo/bar/a space/that!/this"))
     319       (equal s
     320              (namestring (pathname s))))
     321     'file-error)
     322  t)
     323
     324(deftest jar-pathname.11
     325    (let ((s "jar:file:/foo/bar/a%20space%3f/that!/this"))
     326      (string= s
    347327             (namestring (pathname s))))
    348328  t)
    349329
    350 (deftest jar-pathname.11
    351     (let ((s "jar:file:/foo/bar/a+space/that!/this"))
    352       (equal s
    353              (namestring (pathname s))))
    354   t)
    355 
     330;;; We allow jar-pathname to be contructed without a device to allow
     331;;; MERGE-PATHNAMES to work, even though #p"file:" is illegal.
     332(deftest jar-pathname.12
     333    (string= (namestring (first (pathname-device #p"jar:file:!/foo.bar")))
     334             "")
     335  t)
    356336
    357337(deftest jar-pathname.match-p.1
  • trunk/abcl/test/lisp/abcl/pathname-tests.lisp

    r13026 r13057  
    16821682  t)
    16831683
     1684(deftest pathname.uri-encoding.1
     1685    (signals-error
     1686     (let ((s "file:/path with /spaces"))
     1687       (equal s
     1688              (namestring (pathname s))))
     1689     'file-error)
     1690  t)
     1691
     1692(deftest pathname.uri-encoding.2
     1693    (equal "/path with/uri-escaped/?characters/"
     1694           (namestring (pathname "file:/path%20with/uri-escaped/%3fcharacters/")))
     1695  t)
     1696
     1697(deftest pathname.load.1
     1698    (let ((dir (merge-pathnames "dir+with+plus/"
     1699                                *abcl-test-directory*)))
     1700      (with-temp-directory (dir)
     1701        (let ((file (merge-pathnames "foo.lisp" dir)))
     1702          (with-open-file (s file :direction :output)
     1703            (write *foo.lisp* :stream s))
     1704          (load file))))
     1705  t)
     1706
     1707(deftest pathname.load.2
     1708    (let ((dir (merge-pathnames "dir with space/"
     1709                                *abcl-test-directory*)))
     1710      (with-temp-directory (dir)
     1711        (let ((file (merge-pathnames "foo.lisp" dir)))
     1712          (with-open-file (s file :direction :output)
     1713            (write *foo.lisp* :stream s))
     1714          (load file))))
     1715  t)
  • trunk/abcl/test/lisp/abcl/test-utilities.lisp

    r12618 r13057  
    3737
    3838#+nil (setf *expected-failures* nil)
     39
Note: See TracChangeset for help on using the changeset viewer.