source: trunk/abcl/test/lisp/abcl/bugs.lisp @ 14238

Last change on this file since 14238 was 14238, checked in by Mark Evenson, 9 years ago

Fixes #243: MAKE-PATHNAME with a DEVICE string.

We allow DEVICE lists to contain a string value as constructed by
MAKE-PATHNAME, but the result can never actually be resolvable by
TRUENAME.

Instead of trying to figure out the proper use of Java labels, just
use the private static Pathname.doTruenameExit() as the common point
for all exits from the TRUENAME implementation.

File size: 4.5 KB
Line 
1(in-package :abcl.test.lisp)
2
3;;; When these bugs get fixed, they should be moved elsewhere in the
4;;; testsuite so they remain fixed.
5
6(deftest bugs.logical-pathname.1
7    #|
8Date: Mon, 18 Jan 2010 10:51:07 -0500
9Message-ID: <29af5e2d1001180751l7cf79a3ay929cef1deb9ed063@mail.gmail.com>
10Subject: Re: [armedbear-devel] translate-logical-pathname and :wild-inferiors
11regression
12From: Alan Ruttenberg <alanruttenberg@gmail.com>
13    |#
14    (progn
15      (setf (logical-pathname-translations "ido") 
16            '(("IDO:IDO-CORE;**;*.*" 
17               "/Users/alanr/repos/infectious-disease-ontology/trunk/src/ontology/ido-core/**/*.*") 
18              ("IDO:IMMUNOLOGY;**;*.*"
19               "/Users/alanr/repos/infectious-disease-ontology/trunk/src/ontology/immunology/**/*.*") 
20              ("IDO:TOOLS;**;*.*" 
21               "/Users/alanr/repos/infectious-disease-ontology/trunk/src/tools/**/*.*") 
22              ("IDO:LIB;**;*.*"
23               "/Users/alanr/repos/infectious-disease-ontology/trunk/lib/**/*.*")))
24      (translate-pathname "IDO:IMMUNOLOGY;" "IDO:IMMUNOLOGY;**;*.*" 
25                          "/Users/alanr/repos/infectious-disease-ontology/trunk/src/ontology/**/*.*"))
26  #P"/users/alanr/repos/infectious-disease-ontology/trunk/src/ontology/")
27
28(deftest bugs.logical-pathname.2
29    #|
30Message-Id: <BBE9D0E5-5166-4D24-9A8A-DC4E766976D1@ISI.EDU>
31From: Thomas Russ <tar@ISI.EDU>
32To: armedbear-devel@common-lisp.net
33Subject: [armedbear-devel] Bug in translate-logical-pathname.
34    |#
35    (progn 
36      (setf (logical-pathname-translations "L")
37            '(("L:NATIVE;**;*.*" "/usr/lisp/abcl/native/**/*.*")))
38      (translate-logical-pathname "L:NATIVE;TEST;FOO.FASL"))
39  #p"/usr/lisp/abcl/native/test/foo.fasl")
40
41     
42(deftest bugs.pathname.1
43    (namestring (make-pathname :directory '(:relative) :name "file" 
44                   :type :unspecific 
45                   :host nil :device nil))
46  "./file")
47
48(deftest bugs.pathname.2
49    (TRANSLATE-PATHNAME 
50     #P"/Users/evenson/work/bordeaux-threads/src/bordeaux-threads.abcl" 
51     #P"/**/**/*.*" 
52     #P"/Users/evenson/.cache/common-lisp/armedbear-0.20.0-dev-darwin-unknown/**/*.*")
53  #P"/Users/evenson/.cache/common-lisp/armedbear-0.20.0-dev-darwin-unknown/bordeaux-threads.abcl")
54
55(deftest bugs.pathname.3 
56    (namestring (MAKE-PATHNAME :HOST NIL :DEVICE NIL 
57                               :DIRECTORY '(:RELATIVE :WILD-INFERIORS) 
58                               :DEFAULTS "/**/"))
59  "**/")
60
61#+abcl
62(deftest bugs.java.1
63    (let* ((a (java:jnew-array "byte" 1))
64           (b (let ((array-list (java:jnew (java:jconstructor
65                                       "java.util.ArrayList"))))
66                (java:jcall (java:jmethod "java.util.AbstractList" "add"
67                                          "java.lang.Object")
68                            array-list a)
69                (java:jcall (java:jmethod "java.util.AbstractList" "get" "int")
70                            array-list 0))))
71      (type-of (sys::%make-byte-array-input-stream b)))
72  stream)
73               
74
75(deftest bugs.readtable-case.1 
76  (let (original-case result)
77    (setf original-case (readtable-case *readtable*)
78          (readtable-case *readtable*) :invert
79          result (list (string (read-from-string "lower"))
80                       (string (read-from-string "UPPER"))
81                       (string (read-from-string "#:lower"))
82                       (string (read-from-string "#:UPPER")))
83          (readtable-case *readtable*) original-case)
84    (values-list result))
85  "LOWER" "upper" "LOWER" "upper")
86
87;;; http://trac.common-lisp.net/armedbear/ticket/165
88(deftest bugs.pprint.1
89    (let ((result (make-array '(0) :element-type 'base-char :fill-pointer t)))
90      (with-output-to-string (s result)
91        (pprint-logical-block (s nil :per-line-prefix "---") 
92          (format s "~(~A~)" '(1 2 3 4))))
93      result)
94  "---(1 2 3 4)")
95
96(deftest bugs.defgeneric.1
97    (let ((symbol (gensym))
98          (docstring "Ipso est genericus")
99          result)
100      (eval `(defgeneric ,symbol nil
101                 (:documentation ,docstring)))
102      (setf result (documentation symbol 'function))
103      (fmakunbound symbol)
104      (string= result docstring))
105  t)
106
107;;; http://trac.common-lisp.net/armedbear/ticket/199
108(deftest bugs.clos.aux.1
109    ((lambda (a &aux (b (+ a 1))) 
110       b)
111     2)
112  3)
113     
114;;; http://trac.common-lisp.net/armedbear/ticket/243
115(deftest bugs.pathname.make-pathname.1
116    (signals-error 
117     (make-pathname :device (list "foo"))
118     'error)
119t)
120
121
122(deftest bugs.pathname.make-pathname.2
123  (probe-file (make-pathname :device (list "foo")))
124nil)
Note: See TracBrowser for help on using the repository browser.