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

[mevenson at common-lisp.net]

Author: mevenson
Date: Fri Jul  8 01:40:37 2011
New Revision: 13380

Log:
Fasls are no no longer created with *PRINT-READABLY*.

This fixes #156 in which the compiler could no longer dump forms into
the fasls containing arrays of (UNSIGNED-BYTE 32) because in r13274 we
required that all forms be created with a non-nil *PRINT-READABLY*.
Presumably, SimpleArray_UnsignedByte32.writeToString() signals an
error when invoked with a non-NIL *PRINT-READABLY* because the
resulting read of the form will not necessarily be of the specified
base type.

With this change, we restore ABCL's behavior before r13274 to fix
#147, which is to read a create a less precise type from the fasl.

The more correct solution would be to dump some aspects of the fasls
directly into JVM code that would perform the stricter intialization.

Tests added for both cases to ensure this remains fixed.

Modified:
   trunk/abcl/src/org/armedbear/lisp/dump-form.lisp
   trunk/abcl/test/lisp/abcl/compiler-tests.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/dump-form.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/dump-form.lisp	Tue Jul  5 02:34:08 2011	(r13379)
+++ trunk/abcl/src/org/armedbear/lisp/dump-form.lisp	Fri Jul  8 01:40:37 2011	(r13380)
@@ -134,6 +134,11 @@
         (*print-lines* nil)
         (*print-pretty* nil)
         (*print-radix* nil)
+#+nil ;; XXX Some types (q.v. (UNSIGNED-BYTE 32)) don't have a
+      ;; readable syntax because they don't roundtrip to the same
+      ;; type, but still return a Lisp object that "works", albeit
+      ;; perhaps inefficiently when READ from their DUMP-FORM
+      ;; representation.
         (*print-readably* t)
         (*print-right-margin* nil)
         (*print-structure* t)

Modified: trunk/abcl/test/lisp/abcl/compiler-tests.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/compiler-tests.lisp	Tue Jul  5 02:34:08 2011	(r13379)
+++ trunk/abcl/test/lisp/abcl/compiler-tests.lisp	Fri Jul  8 01:40:37 2011	(r13380)
@@ -443,3 +443,38 @@
   :args (#.most-positive-java-long #.most-negative-java-long)
   :results #.most-positive-java-long)
 
+;;; ticket #147
+(deftest compiler.1 
+    (let ((tmpfile (ext::make-temp-file))
+          (forms `((in-package :cl-user)
+                     (eval-when (:compile-toplevel :load-toplevel :execute)
+                       (setf *print-case* ':downcase))
+                     (defstruct rec a b))))
+      (with-open-file (s tmpfile :direction :output)
+        (dolist (form forms)
+          (write form :stream s)))
+      (let ((result (compile-file tmpfile)))
+        (delete-file tmpfile)
+        (not (null result))))
+  t)
+
+;;; ticket #156
+(deftest compiler.2
+    (let ((tmpfile (ext::make-temp-file))
+          (line "(defconstant a #.(make-array '(8 256) 
+                    :element-type '(unsigned-byte 32) :initial-element 0))"))
+      (with-open-file (s tmpfile :direction :output)
+        (format s "~A" line))
+      (let ((result (compile-file tmpfile)))
+    #+nil    (delete-file tmpfile)
+        (not (null result))))
+  t)
+
+
+
+
+
+        
+
+        
+        
\ No newline at end of file