[armedbear-cvs] r13508 - in trunk/abcl: src/org/armedbear/lisp test/lisp/abcl

[mevenson at common-lisp.net]

Author: mevenson
Date: Tue Aug 16 02:49:25 2011
New Revision: 13508

Log:
Fix #148: READTABLE-CASE :invert doesn't work for symbols.

A slightly modified version of the patch provided by Ole Arnedt with a
test.

Modified:
   trunk/abcl/src/org/armedbear/lisp/Stream.java
   trunk/abcl/test/lisp/abcl/bugs.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/Stream.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Stream.java	Tue Aug 16 01:43:24 2011	(r13507)
+++ trunk/abcl/src/org/armedbear/lisp/Stream.java	Tue Aug 16 02:49:25 2011	(r13508)
@@ -545,15 +545,15 @@
     public LispObject readSymbol() {
         final Readtable rt =
             (Readtable) Symbol.CURRENT_READTABLE.symbolValue(LispThread.currentThread());
-        StringBuilder sb = new StringBuilder();
-        _readToken(sb, rt);
-        return new Symbol(sb.toString());
+        return readSymbol(rt);
     }
 
     public LispObject readSymbol(Readtable rt) {
-        StringBuilder sb = new StringBuilder();
-        _readToken(sb, rt);
-        return new Symbol(sb.toString());
+        final StringBuilder sb = new StringBuilder();
+        final BitSet flags = _readToken(sb, rt);
+        return new Symbol(rt.getReadtableCase() == Keyword.INVERT
+                          ? invert(sb.toString(), flags)
+                          : sb.toString());
     }
 
     public LispObject readStructure(ReadtableAccessor rta) {

Modified: trunk/abcl/test/lisp/abcl/bugs.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/bugs.lisp	Tue Aug 16 01:43:24 2011	(r13507)
+++ trunk/abcl/test/lisp/abcl/bugs.lisp	Tue Aug 16 02:49:25 2011	(r13508)
@@ -71,4 +71,15 @@
   stream)
                 
                     
-                    
\ No newline at end of file
+
+(deftest bugs.readtable-case.1 
+  (let (original-case result)
+    (setf original-case (readtable-case *readtable*)
+          (readtable-case *readtable*) :invert
+          result (list (string (read-from-string "lower"))
+                       (string (read-from-string "UPPER"))
+                       (string (read-from-string "#:lower"))
+                       (string (read-from-string "#:UPPER")))
+          (readtable-case *readtable*) original-case)
+    (values-list result))
+  "LOWER" "upper" "LOWER" "upper")
\ No newline at end of file