[armedbear-cvs] r13066 - in branches/0.23.x/abcl: . test/lisp/abcl
Mark Evenson
mevenson at common-lisp.net
Mon Nov 29 08:52:06 UTC 2010
Author: mevenson
Date: Mon Nov 29 03:52:05 2010
New Revision: 13066
Log:
[backport r13057] Tests for the implementation of URI encoding.
Added:
branches/0.23.x/abcl/test/lisp/abcl/utilities.lisp
- copied unchanged from r13057, /trunk/abcl/test/lisp/abcl/utilities.lisp
Modified:
branches/0.23.x/abcl/abcl.asd
branches/0.23.x/abcl/test/lisp/abcl/jar-pathname.lisp
branches/0.23.x/abcl/test/lisp/abcl/pathname-tests.lisp
branches/0.23.x/abcl/test/lisp/abcl/test-utilities.lisp
Modified: branches/0.23.x/abcl/abcl.asd
==============================================================================
--- branches/0.23.x/abcl/abcl.asd (original)
+++ branches/0.23.x/abcl/abcl.asd Mon Nov 29 03:52:05 2010
@@ -24,17 +24,19 @@
;;; We guard with #+abcl for tests that other Lisps cannot load. This
;;; could be possibly be done at finer granularity in the files
;;; themselves.
-(defsystem :abcl-test-lisp :version "1.1" :components
+(defsystem :abcl-test-lisp :version "1.2" :components
((:module abcl-rt
:pathname "test/lisp/abcl/" :serial t :components
- ((:file "rt-package") (:file "rt")
+ ((:file "rt-package")
+ (:file "rt")
(:file "test-utilities")))
(:module package :depends-on (abcl-rt)
:pathname "test/lisp/abcl/" :components
((:file "package")))
(:module test :depends-on (package)
:pathname "test/lisp/abcl/" :components
- ((:file "compiler-tests")
+ ((:file "utilities")
+ (:file "compiler-tests")
(:file "condition-tests")
#+abcl
(:file "class-file")
@@ -47,7 +49,7 @@
(:file "file-system-tests")
#+abcl
(:file "jar-pathname" :depends-on
- ("pathname-tests"))
+ ("utilities" "pathname-tests" "file-system-tests"))
#+abcl
(:file "url-pathname")
(:file "math-tests")
@@ -57,7 +59,7 @@
(:file "bugs" :depends-on ("file-system-tests"))
(:file "wild-pathnames" :depends-on ("file-system-tests"))
#+abcl
- (:file "pathname-tests")))))
+ (:file "pathname-tests" :depends-on ("utilities"))))))
(defmethod perform ((o test-op) (c (eql (find-system 'abcl-test-lisp))))
"Invoke tests with (asdf:oos 'asdf:test-op :abcl-test-lisp)."
Modified: branches/0.23.x/abcl/test/lisp/abcl/jar-pathname.lisp
==============================================================================
--- branches/0.23.x/abcl/test/lisp/abcl/jar-pathname.lisp (original)
+++ branches/0.23.x/abcl/test/lisp/abcl/jar-pathname.lisp Mon Nov 29 03:52:05 2010
@@ -2,37 +2,6 @@
(defvar *jar-file-init* nil)
-;;; From CL-FAD
-(defvar *stream-buffer-size* 8192)
-(defun cl-fad-copy-stream (from to &optional (checkp t))
- "Copies into TO \(a stream) from FROM \(also a stream) until the end
-of FROM is reached, in blocks of *stream-buffer-size*. The streams
-should have the same element type. If CHECKP is true, the streams are
-checked for compatibility of their types."
- (when checkp
- (unless (subtypep (stream-element-type to) (stream-element-type from))
- (error "Incompatible streams ~A and ~A." from to)))
- (let ((buf (make-array *stream-buffer-size*
- :element-type (stream-element-type from))))
- (loop
- (let ((pos (read-sequence buf from)))
- (when (zerop pos) (return))
- (write-sequence buf to :end pos))))
- (values))
-
-(defun cl-fad-copy-file (from to &key overwrite)
- "Copies the file designated by the non-wild pathname designator FROM
-to the file designated by the non-wild pathname designator TO. If
-OVERWRITE is true overwrites the file designtated by TO if it exists."
- (let ((element-type '(unsigned-byte 8)))
- (with-open-file (in from :element-type element-type)
- (with-open-file (out to :element-type element-type
- :direction :output
- :if-exists (if overwrite
- :supersede :error))
- (cl-fad-copy-stream in out))))
- (values))
-
(defun jar-file-init ()
(let* ((*default-pathname-defaults* *abcl-test-directory*)
(asdf::*verbose-out* *standard-output*))
@@ -197,12 +166,14 @@
#p#.(format nil "jar:jar:file:~Abaz.jar!/a/b/bar.abcl!/bar._"
(namestring *abcl-test-directory*)))
+(push 'jar-pathname.probe-file.4 *expected-failures*)
(deftest jar-pathname.probe-file.4
(with-jar-file-init
(probe-file "jar:file:baz.jar!/a/b"))
#p#.(format nil "jar:file:~Abaz.jar!/a/b/"
(namestring *abcl-test-directory*)))
+(push 'jar-pathname.probe-file.5 *expected-failures*)
(deftest jar-pathname.probe-file.5
(with-jar-file-init
(probe-file "jar:file:baz.jar!/a/b/"))
@@ -341,18 +312,27 @@
(:relative "a" "b") "foo" "jar"
(:absolute "c" "d") "foo" "lisp")
+;;; 'jar:file:' forms must be URI encoded, meaning whitespace is not allowed
(deftest jar-pathname.10
- (let ((s "jar:file:/foo/bar/a space/that!/this"))
- (equal s
- (namestring (pathname s))))
+ (signals-error
+ (let ((s "jar:file:/foo/bar/a space/that!/this"))
+ (equal s
+ (namestring (pathname s))))
+ 'file-error)
t)
(deftest jar-pathname.11
- (let ((s "jar:file:/foo/bar/a+space/that!/this"))
- (equal s
+ (let ((s "jar:file:/foo/bar/a%20space%3f/that!/this"))
+ (string= s
(namestring (pathname s))))
t)
+;;; We allow jar-pathname to be contructed without a device to allow
+;;; MERGE-PATHNAMES to work, even though #p"file:" is illegal.
+(deftest jar-pathname.12
+ (string= (namestring (first (pathname-device #p"jar:file:!/foo.bar")))
+ "")
+ t)
(deftest jar-pathname.match-p.1
(pathname-match-p "jar:file:/a/b/some.jar!/a/system/def.asd"
Modified: branches/0.23.x/abcl/test/lisp/abcl/pathname-tests.lisp
==============================================================================
--- branches/0.23.x/abcl/test/lisp/abcl/pathname-tests.lisp (original)
+++ branches/0.23.x/abcl/test/lisp/abcl/pathname-tests.lisp Mon Nov 29 03:52:05 2010
@@ -1681,3 +1681,35 @@
(type-error () t))
t)
+(deftest pathname.uri-encoding.1
+ (signals-error
+ (let ((s "file:/path with /spaces"))
+ (equal s
+ (namestring (pathname s))))
+ 'file-error)
+ t)
+
+(deftest pathname.uri-encoding.2
+ (equal "/path with/uri-escaped/?characters/"
+ (namestring (pathname "file:/path%20with/uri-escaped/%3fcharacters/")))
+ t)
+
+(deftest pathname.load.1
+ (let ((dir (merge-pathnames "dir+with+plus/"
+ *abcl-test-directory*)))
+ (with-temp-directory (dir)
+ (let ((file (merge-pathnames "foo.lisp" dir)))
+ (with-open-file (s file :direction :output)
+ (write *foo.lisp* :stream s))
+ (load file))))
+ t)
+
+(deftest pathname.load.2
+ (let ((dir (merge-pathnames "dir with space/"
+ *abcl-test-directory*)))
+ (with-temp-directory (dir)
+ (let ((file (merge-pathnames "foo.lisp" dir)))
+ (with-open-file (s file :direction :output)
+ (write *foo.lisp* :stream s))
+ (load file))))
+ t)
Modified: branches/0.23.x/abcl/test/lisp/abcl/test-utilities.lisp
==============================================================================
--- branches/0.23.x/abcl/test/lisp/abcl/test-utilities.lisp (original)
+++ branches/0.23.x/abcl/test/lisp/abcl/test-utilities.lisp Mon Nov 29 03:52:05 2010
@@ -36,3 +36,4 @@
#+nil (rem-all-tests)
#+nil (setf *expected-failures* nil)
+
More information about the armedbear-cvs
mailing list