[armedbear-cvs] r12610 - in trunk/abcl: . test/lisp/abcl
Mark Evenson
mevenson at common-lisp.net
Thu Apr 15 14:37:00 UTC 2010
Author: mevenson
Date: Thu Apr 15 10:36:59 2010
New Revision: 12610
Log:
Separate jar and URL pathname tests into distinct files.
Added:
trunk/abcl/test/lisp/abcl/jar-pathname.lisp
- copied, changed from r12609, /trunk/abcl/test/lisp/abcl/jar-file.lisp
trunk/abcl/test/lisp/abcl/url-pathname.lisp
Removed:
trunk/abcl/test/lisp/abcl/jar-file.lisp
Modified:
trunk/abcl/abcl.asd
Modified: trunk/abcl/abcl.asd
==============================================================================
--- trunk/abcl/abcl.asd (original)
+++ trunk/abcl/abcl.asd Thu Apr 15 10:36:59 2010
@@ -35,7 +35,8 @@
(:file "mop-tests-setup")
(:file "mop-tests" :depends-on ("mop-tests-setup"))
(:file "file-system-tests")
- (:file "jar-file" :depend-on ("pathname-test"))
+ (:file "jar-pathname" :depend-on ("pathname-test"))
+ (:file "url-pathname")
(:file "math-tests")
(:file "misc-tests")
(:file "bugs")
Copied: trunk/abcl/test/lisp/abcl/jar-pathname.lisp (from r12609, /trunk/abcl/test/lisp/abcl/jar-file.lisp)
==============================================================================
--- /trunk/abcl/test/lisp/abcl/jar-file.lisp (original)
+++ trunk/abcl/test/lisp/abcl/jar-pathname.lisp Thu Apr 15 10:36:59 2010
@@ -71,59 +71,52 @@
(jar-file-init))
, at body)))
-#+nil
-(defmacro with-jar-file-init (&rest body)
- `(progv '(*default-pathname-defaults*) '(,*abcl-test-directory*)
- (unless *jar-file-init*
- (load-init))
- , at body))
-
-(deftest jar-file.load.1
+(deftest jar-pathname.load.1
(with-jar-file-init
(load "jar:file:baz.jar!/foo"))
t)
-(deftest jar-file.load.2
+(deftest jar-pathname.load.2
(with-jar-file-init
(load "jar:file:baz.jar!/bar"))
t)
-(deftest jar-file.load.3
+(deftest jar-pathname.load.3
(with-jar-file-init
(load "jar:file:baz.jar!/bar.abcl"))
t)
-(deftest jar-file.load.4
+(deftest jar-pathname.load.4
(with-jar-file-init
(load "jar:file:baz.jar!/eek"))
t)
-(deftest jar-file.load.5
+(deftest jar-pathname.load.5
(with-jar-file-init
(load "jar:file:baz.jar!/eek.lisp"))
t)
-(deftest jar-file.load.6
+(deftest jar-pathname.load.6
(with-jar-file-init
(load "jar:file:baz.jar!/a/b/foo"))
t)
-(deftest jar-file.load.7
+(deftest jar-pathname.load.7
(with-jar-file-init
(load "jar:file:baz.jar!/a/b/bar"))
t)
-(deftest jar-file.load.8
+(deftest jar-pathname.load.8
(with-jar-file-init
(load "jar:file:baz.jar!/a/b/bar.abcl"))
t)
-(deftest jar-file.load.9
+(deftest jar-pathname.load.9
(with-jar-file-init
(load "jar:file:baz.jar!/a/b/eek"))
t)
-(deftest jar-file.load.10
+(deftest jar-pathname.load.10
(with-jar-file-init
(load "jar:file:baz.jar!/a/b/eek.lisp"))
t)
@@ -132,113 +125,113 @@
;;; XXX come up with a better abstraction
(progn
- (deftest jar-file.load.11
+ (deftest jar-pathname.load.11
(load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/foo")
t)
- (deftest jar-file.load.12
+ (deftest jar-pathname.load.12
(load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/bar")
t)
- (deftest jar-file.load.13
+ (deftest jar-pathname.load.13
(load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/bar.abcl")
t)
- (deftest jar-file.load.14
+ (deftest jar-pathname.load.14
(load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/eek")
t)
- (deftest jar-file.load.15
+ (deftest jar-pathname.load.15
(load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/eek.lisp")
t)
- (deftest jar-file.load.16
+ (deftest jar-pathname.load.16
(load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/a/b/foo")
t)
- (deftest jar-file.load.17
+ (deftest jar-pathname.load.17
(load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/a/b/bar")
t)
- (deftest jar-file.load.18
+ (deftest jar-pathname.load.18
(load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/a/b/bar.abcl")
t)
- (deftest jar-file.load.19
+ (deftest jar-pathname.load.19
(load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/a/b/eek")
t)
- (deftest jar-file.load.20
+ (deftest jar-pathname.load.20
(load "jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/a/b/eek.lisp")
t))
-(deftest jar-file.probe-file.1
+(deftest jar-pathname.probe-file.1
(with-jar-file-init
(probe-file "jar:file:baz.jar!/eek.lisp"))
#p#.(format nil "jar:file:~A/baz.jar!/eek.lisp"
(namestring *abcl-test-directory*)))
-(deftest jar-file.probe-file.2
+(deftest jar-pathname.probe-file.2
(with-jar-file-init
(probe-file "jar:file:baz.jar!/a/b/bar.abcl"))
#p#.(format nil "jar:file:~A/baz.jar!/a/b/bar.abcl"
(namestring *abcl-test-directory*)))
-(deftest jar-file.probe-file.3
+(deftest jar-pathname.probe-file.3
(with-jar-file-init
(probe-file "jar:jar:file:baz.jar!/a/b/bar.abcl!/bar._"))
#p#.(format nil "jar:jar:file:~Abaz.jar!/a/b/bar.abcl!/bar._"
(namestring *abcl-test-directory*)))
-(deftest jar-file.probe-file.4
+(deftest jar-pathname.probe-file.4
(with-jar-file-init
(probe-file "jar:file:baz.jar!/a/b"))
nil)
-(deftest jar-file.probe-file.5
+(deftest jar-pathname.probe-file.5
(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*)))
-(deftest jar-file.merge-pathnames.1
+(deftest jar-pathname.merge-pathnames.1
(merge-pathnames
"/bar.abcl" #p"jar:file:baz.jar!/foo")
#p"jar:file:baz.jar!/bar.abcl")
-(deftest jar-file.merge-pathnames.2
+(deftest jar-pathname.merge-pathnames.2
(merge-pathnames
"bar.abcl" #p"jar:file:baz.jar!/foo/")
#p"jar:file:baz.jar!/foo/bar.abcl")
-(deftest jar-file.merge-pathnames.3
+(deftest jar-pathname.merge-pathnames.3
(merge-pathnames
"jar:file:baz.jar!/foo" "bar")
#p"jar:file:baz.jar!/foo")
-(deftest jar-file.merge-pathnames.4
+(deftest jar-pathname.merge-pathnames.4
(merge-pathnames
"jar:file:baz.jar!/foo" "/a/b/c")
#p"jar:file:/a/b/baz.jar!/foo")
-(deftest jar-file.merge-pathnames.5
+(deftest jar-pathname.merge-pathnames.5
(merge-pathnames "jar:file:/a/b/c/foo.jar!/bar/baz.lisp")
#p"jar:file:/a/b/c/foo.jar!/bar/baz.lisp")
-(deftest jar-file.truename.1
+(deftest jar-pathname.truename.1
(signals-error (truename "jar:file:baz.jar!/foo")
'file-error)
t)
-(deftest jar-file.pathname.1
+(deftest jar-pathname.1
(let* ((p #p"jar:file:foo/baz.jar!/")
(d (first (pathname-device p))))
(values
(pathname-directory d) (pathname-name d) (pathname-type d)))
(:relative "foo") "baz" "jar")
-(deftest jar-file.pathname.2
+(deftest jar-pathname.2
(let* ((p #p"jar:file:baz.jar!/foo.abcl")
(d (first (pathname-device p))))
(values
@@ -247,7 +240,7 @@
"baz" "jar"
(:absolute) "foo" "abcl")
-(deftest jar-file.pathname.3
+(deftest jar-pathname.3
(let* ((p #p"jar:jar:file:baz.jar!/foo.abcl!/")
(d0 (first (pathname-device p)))
(d1 (second (pathname-device p))))
@@ -257,7 +250,7 @@
"baz" "jar"
"foo" "abcl")
-(deftest jar-file.pathname.4
+(deftest jar-pathname.4
(let* ((p #p"jar:jar:file:a/baz.jar!/b/c/foo.abcl!/this/that/foo-20.cls")
(d0 (first (pathname-device p)))
(d1 (second (pathname-device p))))
@@ -269,7 +262,7 @@
(:relative "b" "c") "foo" "abcl"
(:absolute "this" "that") "foo-20" "cls")
-(deftest jar-file.pathname.5
+(deftest jar-pathname.5
(let* ((p #p"jar:jar:file:a/foo/baz.jar!/b/c/foo.abcl!/armed/bear/bar-1.cls")
(d0 (first (pathname-device p)))
(d1 (second (pathname-device p))))
@@ -281,37 +274,40 @@
(:relative "b" "c") "foo" "abcl"
(:absolute "armed" "bear") "bar-1" "cls")
-(deftest jar-file.pathname.6
+(deftest jar-pathname.6
(let* ((p #p"jar:http://example.org/abcl.jar!/org/armedbear/lisp/Version.class")
(d (first (pathname-device p))))
-
(values
- d
+ (pathname-url-p d)
+ (namestring d)
(pathname-directory p) (pathname-name p) (pathname-type p)))
+ t
"http://example.org/abcl.jar"
(:absolute "org" "armedbear" "lisp") "Version" "class")
-(deftest jar-file.pathname.7
+(deftest jar-pathname.7
(let* ((p #p"jar:jar:http://example.org/abcl.jar!/foo.abcl!/foo-1.cls")
(d (pathname-device p))
(d0 (first d))
(d1 (second d)))
(values
- d0
+ (pathname-url-p d0)
+ (namestring d0)
(pathname-name d1) (pathname-type d1)
(pathname-name p) (pathname-type p)))
+ t
"http://example.org/abcl.jar"
"foo" "abcl"
"foo-1" "cls")
-(deftest jar-file.pathname.8
+(deftest jar-pathname.8
(let* ((p #p"jar:file:/a/b/foo.jar!/")
(d (first (pathname-device p))))
(values
(pathname-directory d) (pathname-name d) (pathname-type d)))
(:ABSOLUTE "a" "b") "foo" "jar")
-(deftest jar-file.pathname.9
+(deftest jar-pathname.9
(let* ((p #p"jar:file:a/b/foo.jar!/c/d/foo.lisp")
(d (first (pathname-device p))))
(values
@@ -320,41 +316,28 @@
(:relative "a" "b") "foo" "jar"
(:absolute "c" "d") "foo" "lisp")
-(deftest jar-file.pathname-match-p.1
+(deftest jar-pathname.match-p.1
(pathname-match-p "jar:file:/a/b/some.jar!/a/system/def.asd"
"jar:file:/**/*.jar!/**/*.asd")
t)
-(deftest jar-file.pathname-match-p.2
+(deftest jar-pathname.match-p.2
(pathname-match-p "/a/system/def.asd"
"jar:file:/**/*.jar!/**/*.asd")
nil)
-(deftest jar-file.pathname-match-p.3
+(deftest jar-pathname.match-p.3
(pathname-match-p "jar:file:/a/b/some.jar!/a/system/def.asd"
"/**/*.asd")
nil)
-(deftest jar-file.translate-pathname.1
+(deftest jar-pathname.translate.1
(namestring
(translate-pathname "jar:file:/a/b/c.jar!/d/e/f.lisp"
"jar:file:/**/*.jar!/**/*.*"
"/foo/**/*.*"))
"/foo/d/e/f.lisp")
-;; URL Pathname tests
-(deftest pathname-url.1
- (let* ((p #p"http://example.org/a/b/foo.lisp")
- (host (pathname-host p)))
- (values
- (check-physical-pathname p '(:absolute "a" "b") "foo" "lisp")
- (and (consp host)
- (equal (getf host :scheme)
- "http")
- (equal (getf host :authority)
- "example.org"))))
- (t t))
-
Added: trunk/abcl/test/lisp/abcl/url-pathname.lisp
==============================================================================
--- (empty file)
+++ trunk/abcl/test/lisp/abcl/url-pathname.lisp Thu Apr 15 10:36:59 2010
@@ -0,0 +1,30 @@
+(in-package #:abcl.test.lisp)
+
+;; URL Pathname tests
+(deftest pathname-url.1
+ (let* ((p #p"http://example.org/a/b/foo.lisp")
+ (host (pathname-host p)))
+ (values
+ (check-physical-pathname p '(:absolute "a" "b") "foo" "lisp")
+ (and (consp host)
+ (equal (getf host :scheme)
+ "http")
+ (equal (getf host :authority)
+ "example.org"))))
+ (t t))
+
+(deftest pathname-url.2
+ (let* ((p #p"http://example.org/a/b/foo.lisp?query=this#that-fragment")
+ (host (pathname-host p)))
+ (values
+ (check-physical-pathname p '(:absolute "a" "b") "foo" "lisp")
+ (and (consp host)
+ (equal (getf host :scheme)
+ "http")
+ (equal (getf host :authority)
+ "example.org")
+ (equal (getf host :query)
+ "query=this")
+ (equal (getf host :fragment)
+ "that-fragment"))))
+ (t t))
More information about the armedbear-cvs
mailing list