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

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

Additional test for &aux problems. See ticket #199.

File size: 4.9 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/205
108(deftest bugs.with-constant-signature.1 
109    (progn 
110      (require :abcl-contrib)
111      (require :jss)
112      (jss:with-constant-signature ((substring "substring")) 
113        (substring "01234" 2)))
114  "234")
115
116
117;;; http://trac.common-lisp.net/armedbear/ticket/199
118(deftest bugs.clos.aux.1 
119    ;;; XXX possible collision with previously defined names
120    (progn
121      (defclass room ()
122        ((decorators :reader room-decorators)))
123      (defgeneric decorators (room))
124      (defmethod decorators ((room room) 
125                             &aux (d (decorators room)))
126        d)
127      (decorators (make-instance 'room)))
128  t)
129
130(deftest bugs.aux.1
131    ((lambda (a &aux (b (+ a 1))) 
132       b)
133     2)
134  3)
135     
Note: See TracBrowser for help on using the repository browser.