From mevenson at common-lisp.net Fri Jul 1 14:00:28 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 01 Jul 2011 07:00:28 -0700 Subject: [armedbear-cvs] r13369 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: mevenson Date: Fri Jul 1 07:00:27 2011 New Revision: 13369 Log: Make JAVA:ADD-TO-CLASSPATH a generic function. With this change we can customize the mechanism for changing the classpath. The first planned use is for JSS to use an :after method to be informed of classpath additions, so we can factor out the ASDF portion into the ABCL-ASDF extension package. Add JAVA:GET-CURRENT-CLASSLOADER to access a wrapped instance of the underlying current JVM classloader being used by ABCL. Modified: trunk/abcl/src/org/armedbear/lisp/Autoload.java trunk/abcl/src/org/armedbear/lisp/JavaClassLoader.java trunk/abcl/src/org/armedbear/lisp/Symbol.java trunk/abcl/src/org/armedbear/lisp/java.lisp Modified: trunk/abcl/src/org/armedbear/lisp/Autoload.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Autoload.java Wed Jun 29 15:04:37 2011 (r13368) +++ trunk/abcl/src/org/armedbear/lisp/Autoload.java Fri Jul 1 07:00:27 2011 (r13369) @@ -532,7 +532,7 @@ autoload(PACKAGE_JAVA, "%load-java-class-from-byte-array", "RuntimeClass"); autoload(PACKAGE_JAVA, "get-default-classloader", "JavaClassLoader"); autoload(PACKAGE_JAVA, "make-classloader", "JavaClassLoader"); - autoload(PACKAGE_JAVA, "add-to-classpath", "JavaClassLoader"); + autoload(PACKAGE_JAVA, "%add-to-classpath", "JavaClassLoader"); autoload(PACKAGE_JAVA, "dump-classpath", "JavaClassLoader"); autoload(PACKAGE_MOP, "funcallable-instance-function", "StandardGenericFunction", false); autoload(PACKAGE_MOP, "generic-function-name", "StandardGenericFunction", true); Modified: trunk/abcl/src/org/armedbear/lisp/JavaClassLoader.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/JavaClassLoader.java Wed Jun 29 15:04:37 2011 (r13368) +++ trunk/abcl/src/org/armedbear/lisp/JavaClassLoader.java Fri Jul 1 07:00:27 2011 (r13369) @@ -197,13 +197,26 @@ } }; - // ### add-to-classpath jar-or-jars &optional (classloader (get-current-classloader)) + private static final Primitive GET_CURRENT_CLASSLOADER = new pf_get_current_classloader(); + @DocString(name="get-current-classloader") + private static final class pf_get_current_classloader extends Primitive { + pf_get_current_classloader() { + super("get-current-classloader", PACKAGE_JAVA, true); + } + @Override + public LispObject execute() { + return new JavaObject(getCurrentClassLoader()); + } + }; + + // ### %add-to-classpath jar-or-jars &optional (classloader (get-current-classloader)) private static final Primitive ADD_TO_CLASSPATH = new pf_add_to_classpath(); private static final class pf_add_to_classpath extends Primitive { pf_add_to_classpath() { - super("add-to-classpath", PACKAGE_JAVA, true, "jar-or-jars &optional (classloader (get-current-classloader))"); + super("%add-to-classpath", PACKAGE_JAVA, false, + "jar-or-jars &optional (classloader (get-current-classloader))"); } @Override Modified: trunk/abcl/src/org/armedbear/lisp/Symbol.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Symbol.java Wed Jun 29 15:04:37 2011 (r13368) +++ trunk/abcl/src/org/armedbear/lisp/Symbol.java Fri Jul 1 07:00:27 2011 (r13369) @@ -2976,7 +2976,7 @@ public static final Symbol JAVA_OBJECT = PACKAGE_JAVA.addExternalSymbol("JAVA-OBJECT"); public static final Symbol JAVA_CLASS = - PACKAGE_JAVA.addExternalSymbol("JAVA-CLASS"); + PACKAGE_JAVA.addExternalSymbol("JAVA-CLASS"); public static final Symbol JCALL = PACKAGE_JAVA.addExternalSymbol("JCALL"); public static final Symbol JCALL_RAW = @@ -2991,6 +2991,8 @@ PACKAGE_JAVA.addExternalSymbol("JMETHOD-RETURN-TYPE"); public static final Symbol JRESOLVE_METHOD = PACKAGE_JAVA.addExternalSymbol("JRESOLVE-METHOD"); + public static final Symbol ADD_TO_CLASSPATH = + PACKAGE_JAVA.addExternalSymbol("ADD-TO-CLASSPATH"); // External symbols in SYSTEM package. public static final Symbol _ENABLE_AUTOCOMPILE_ = Modified: trunk/abcl/src/org/armedbear/lisp/java.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/java.lisp Wed Jun 29 15:04:37 2011 (r13368) +++ trunk/abcl/src/org/armedbear/lisp/java.lisp Fri Jul 1 07:00:27 2011 (r13369) @@ -43,6 +43,11 @@ (dolist (url urls) (add-url-to-classpath url))) +(defgeneric add-to-classpath (jar-or-jars &optional classloader)) + +(defmethod add-to-classpath (jar-or-jars &optional (classloader (get-current-classloader))) + (%add-to-classpath jar-or-jars classloader)) + (defun jregister-handler (object event handler &key data count) (%jregister-handler object event handler data count)) From mevenson at common-lisp.net Fri Jul 1 16:53:18 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 01 Jul 2011 09:53:18 -0700 Subject: [armedbear-cvs] r13370 - in trunk/abcl: . contrib Message-ID: Author: mevenson Date: Fri Jul 1 09:53:18 2011 New Revision: 13370 Log: Add support for releasing the contrib with Maven artifacts. Create a "versioned" contrib jar as part of the release. N.B. the pom.xml and instructions are untested. Added: trunk/abcl/contrib/pom.xml Modified: trunk/abcl/build.xml trunk/abcl/maven-release.txt Modified: trunk/abcl/build.xml ============================================================================== --- trunk/abcl/build.xml Fri Jul 1 07:00:27 2011 (r13369) +++ trunk/abcl/build.xml Fri Jul 1 09:53:18 2011 (r13370) @@ -927,6 +927,8 @@ depends="abcl.binary.tar,abcl.source.tar,abcl.binary.zip,abcl.source.zip"> + Added: trunk/abcl/contrib/pom.xml ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ trunk/abcl/contrib/pom.xml Fri Jul 1 09:53:18 2011 (r13370) @@ -0,0 +1,56 @@ + + + + + + 4.0.0 + + org.sonatype.oss + oss-parent + 6 + + org.armedbear.lisp + abcl-contrib + 0.26.0-SNAPSHOT + jar + Armed Bear Common Lisp (ABCL) Contribs + Extra packages--contribs--for ABCL + http://common-lisp/project/armedbear + + + GNU General Public License with Classpath exception + http://www.gnu.org/software/classpath/license.html + repo + + + + scm:svn:svn://common-lisp.net/project/armedbear/svn/trunk/ + scm:svn:svn+ssh://common-lisp.net/project/armedbear/svn/trunk/ + http://common-lisp.net/websvn/listing.php?repname=armedbear + + + + ehu + Erik Huelsmann + ehuels (at) gmail (dot) com + + + easyE + Mark Evenson + evenson (at) panix (dot) com + + + V-ille + Ville Voutilainen + ville.voutilainen (at) gmail (dot) com + + + astalla + Alessio Stalla + alessiostalla (at) gmail (dot) com + + + + Modified: trunk/abcl/maven-release.txt ============================================================================== --- trunk/abcl/maven-release.txt Fri Jul 1 07:00:27 2011 (r13369) +++ trunk/abcl/maven-release.txt Fri Jul 1 09:53:18 2011 (r13370) @@ -14,9 +14,8 @@ # # First, remember to build it! -ant abcl.jar -ant abcl.source.jar -ant abcl.javadoc.jar +ant abcl.jar abcl.source.jar abcl.javadoc.jar abcl.contrib + # And maybe test it as well ant abcl.test @@ -24,11 +23,13 @@ mvn gpg:sign-and-deploy-file -Dfile=dist/abcl.jar -DpomFile=pom.xml -Durl=https://oss.sonatype.org/content/repositories/snapshots/ -DrepositoryId=sonatype-nexus-snapshots mvn gpg:sign-and-deploy-file -Dfile=dist/abcl-${abcl.version}-sources.jar -DpomFile=pom.xml -Durl=https://oss.sonatype.org/content/repositories/snapshots/ -DrepositoryId=sonatype-nexus-snapshots -Dclassifier=sources mvn gpg:sign-and-deploy-file -Dfile=dist/abcl-${abcl.version}-javadoc.jar -DpomFile=pom.xml -Durl=https://oss.sonatype.org/content/repositories/snapshots/ -DrepositoryId=sonatype-nexus-snapshots -Dclassifier=javadoc +mvn gpg:sign-and-deploy-file -Dfile=dist/abcl-contrib-${abcl.version}-jar -DpomFile=contrib/pom.xml -Durl=https://oss.sonatype.org/content/repositories/snapshots/ -DrepositoryId=sonatype-nexus-snapshots # For releases - the version in the POM should be x.y.z mvn gpg:sign-and-deploy-file -Dfile=dist/abcl.jar -DpomFile=pom.xml -Durl=https://oss.sonatype.org/service/local/staging/deploy/maven2/ -DrepositoryId=sonatype-nexus-staging mvn gpg:sign-and-deploy-file -Dfile=dist/abcl-${abcl.version}-sources.jar -DpomFile=pom.xml -Durl=https://oss.sonatype.org/service/local/staging/deploy/maven2/ -DrepositoryId=sonatype-nexus-staging -Dclassifier=sources mvn gpg:sign-and-deploy-file -Dfile=dist/abcl-${abcl.version}-javadoc.jar -DpomFile=pom.xml -Durl=https://oss.sonatype.org/service/local/staging/deploy/maven2/ -DrepositoryId=sonatype-nexus-staging -Dclassifier=javadoc +mvn gpg:sign-and-deploy-file -Dfile=dist/abcl-contrib-${abcl.version}.jar -DpomFile=contrib/pom.xml -Durl=https://oss.sonatype.org/service/local/staging/deploy/maven2/ -DrepositoryId=sonatype-nexus-staging From mevenson at common-lisp.net Mon Jul 4 08:37:32 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Mon, 04 Jul 2011 01:37:32 -0700 Subject: [armedbear-cvs] r13371 - trunk/abcl/doc/design/amop Message-ID: Author: mevenson Date: Mon Jul 4 01:37:27 2011 New Revision: 13371 Log: Standard defintion of AMOP dictionary. To be compared with our current implementation to see what is missing. Added: trunk/abcl/doc/design/amop/ trunk/abcl/doc/design/amop/dictionary.markdown Added: trunk/abcl/doc/design/amop/dictionary.markdown ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ trunk/abcl/doc/design/amop/dictionary.markdown Mon Jul 4 01:37:27 2011 (r13371) @@ -0,0 +1,109 @@ +From http://www.lisp.org/mop/dictionary.html + +# Generic Functions + +add-dependent metaobject dependent +add-direct-method specializer method +add-direct-subclass superclass subclass +add-direct-method specializer method +add-direct-subclass superclass subclass +add-method generic-function method +allocate-instance class &rest initargs + +compute-applicable-methods generic-function arguments +compute-applicable-methods-using-classes generic-function classes +compute-applicable-methods-using-classes generic-function classes +compute-class-precedence-list class +compute-default-initargs class +compute-discriminating-function generic-function +compute-effective-method generic-function method-combination methods +compute-effective-slot-definition class name direct-slot-definitions +compute-slots class +direct-slot-definition-class class &rest initargs +effective-slot-definition-class class &rest initargs + +ensure-class-using-class class name &key direct-default-initargs direct-slots direct-superclasses +name metaclass &allow-other-keys +ensure-generic-function-using-class generic-function function-name &key argument-precedence-order +declarations documentation generic-function-class lambda-list method-class method-combination +name &allow-other-keys +find-method-combination generic-function method-combination-type-name method-combination-options + +make-method-lambda generic-function method lambda-expression environment +map-dependents metaobject function + +reader-method-class class direct-slot &rest initargs +remove-dependent metaobject dependent +remove-direct-method specializer method +remove-direct-subclass superclass subclass +remove-method generic-function method +set-funcallable-instance-function funcallable-instance function +slot-boundp-using-class class object slot + +slot-makunbound-using-class class object slot +slot-value-using-class class object slot +specializer-direct-generic-functions specializer +specializer-direct-methods specializer +standard-instance-access instance location +update-dependent metaobject dependent &rest initargs +validate-superclass class superclass +writer-method-class class direct-slot &rest initargs + +## Readers for Class Metaobjects + +class-default-initargs class +class-direct-default-initargs class +class-direct-slots class +class-direct-subclasses class +class-direct-superclasses class +class-finalized-p class +class-name class +class-precedence-list class +class-prototype class +class-slots class + +## Readers for Generic Function Metaobjects + +generic-function-argument-precedence-order generic-function +generic-function-declarations generic-function +generic-function-lambda-list generic-function +generic-function-method-class generic-function +generic-function-method-combination generic-function +generic-function-methods and generic-function-name generic-function + +## Readers for Method Metaobjects + +method-function method +method-generic-function method +method-lambda-list method +method-specializers method +method-qualifiers method +accessor-method-slot-definition method + +## Direct Slot Definition Metaobjects + +slot-definition-readers direct-slot +slot-definition-writers direct-slot + +## Readers for Slot Definition Metaobjects + +slot-definition-allocation slot +slot-definition-initargs slot +slot-definition-initform slot +slot-definition-initfunction slot +slot-definition-name slot +slot-definition-type slot + + +# Functions + +ensure-class name &key &allow-other-keys +ensure-generic-function function-name &key &allow-other-keys +eql-specializer-object eql-specializer +extract-lambda-list specialized-lambda-list +extract-specializer-names specialized-lambda-list +funcallable-standard-instance-access instance location +intern-eql-specializer object +(setf class-name) new-name class +(setf generic-function-name) new-name generic-function +(setf slot-value-using-class) new-value class object slot From mevenson at common-lisp.net Mon Jul 4 09:02:19 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Mon, 04 Jul 2011 02:02:19 -0700 Subject: [armedbear-cvs] r13372 - trunk/abcl/doc/manual Message-ID: Author: mevenson Date: Mon Jul 4 02:02:18 2011 New Revision: 13372 Log: Document the extension to CLOS specialization for Java objects. Modified: trunk/abcl/doc/manual/abcl.tex Modified: trunk/abcl/doc/manual/abcl.tex ============================================================================== --- trunk/abcl/doc/manual/abcl.tex Mon Jul 4 01:37:27 2011 (r13371) +++ trunk/abcl/doc/manual/abcl.tex Mon Jul 4 02:02:18 2011 (r13372) @@ -368,6 +368,40 @@ \include{extensions} +\subsection{Beyond ANSI} + +Naturally, in striving to be a useful contemporary Common Lisp +implementation, ABCL endeavors to include extensions beyond the ANSI +specification which are either widely adopted or are especially useful +in working with the hosting JVM. + +\subsubsection{Extensions to CLOS} + +There is an additional syntax for specializing the parameter of a +generic function on a java class, viz. (java:jclass CLASS__STRING) +where CLASS__STRING is a string naming a Java class in dotted package +form. + +For instance the following specialization would perhaps allow one to +print more information about the contents of a java.util.Collection +object + +\begin[java]{code} +(defmethod print-object ((coll (java:jclass "java.util.Collection")) stream) + ? + \end[java]{code} + +If the class had been loaded via a classloader other than the original +the class you wish to specialize on, one needs to specify the +classloader as an optional third argument. + +\begin[java]{code} +(defmethod print-object ((device-id (java:jclass "dto.nbi.service.hdm.alcatel.com.NBIDeviceID" + (#"getBaseLoader" cl-user::*classpath-manager*))) + ? + \end[java]{code} + + \section{Multithreading} % TODO document the THREADS package. From mevenson at common-lisp.net Mon Jul 4 14:03:35 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Mon, 04 Jul 2011 07:03:35 -0700 Subject: [armedbear-cvs] r13373 - trunk/abcl/test/lisp/abcl Message-ID: Author: mevenson Date: Mon Jul 4 07:03:33 2011 New Revision: 13373 Log: PATHNAME.URI-ENCODING.1 is not actually failing. But PATHNAME.URI-ENCODING.2 definitely is, which should be addressed. Modified: trunk/abcl/test/lisp/abcl/pathname-tests.lisp Modified: trunk/abcl/test/lisp/abcl/pathname-tests.lisp ============================================================================== --- trunk/abcl/test/lisp/abcl/pathname-tests.lisp Mon Jul 4 02:02:18 2011 (r13372) +++ trunk/abcl/test/lisp/abcl/pathname-tests.lisp Mon Jul 4 07:03:33 2011 (r13373) @@ -1686,12 +1686,12 @@ (let ((s "file:/path with /spaces")) (equal s (namestring (pathname s)))) - 'file-error) + 'error) t) (deftest pathname.uri-encoding.2 - (equal "/path with/uri-escaped/?characters/" - (namestring (pathname "file:/path%20with/uri-escaped/%3fcharacters/"))) + (string-equal "/path with/uri-escaped/?characters/" + (namestring (pathname "file:/path%20with/uri-escaped/%3fcharacters/"))) t) (deftest pathname.load.1 From mevenson at common-lisp.net Mon Jul 4 14:03:43 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Mon, 04 Jul 2011 07:03:43 -0700 Subject: [armedbear-cvs] r13374 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: mevenson Date: Mon Jul 4 07:03:43 2011 New Revision: 13374 Log: Correct mispelling. Modified: trunk/abcl/src/org/armedbear/lisp/Function.java Modified: trunk/abcl/src/org/armedbear/lisp/Function.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Function.java Mon Jul 4 07:03:33 2011 (r13373) +++ trunk/abcl/src/org/armedbear/lisp/Function.java Mon Jul 4 07:03:43 2011 (r13374) @@ -42,7 +42,7 @@ private int hotCount; /** * The value of *load-truename* which was current when this function - * was loaded, used for fetching the class bytes in case of disassebly. + * was loaded, used for fetching the class bytes in case of disassembly. */ private final LispObject loadedFrom; From mevenson at common-lisp.net Mon Jul 4 14:03:53 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Mon, 04 Jul 2011 07:03:53 -0700 Subject: [armedbear-cvs] r13375 - trunk/abcl/doc/design/amop Message-ID: Author: mevenson Date: Mon Jul 4 07:03:52 2011 New Revision: 13375 Log: SET-FUNCALLABLE-INSTANCE-FUNCTION is a function. Modified: trunk/abcl/doc/design/amop/dictionary.markdown Modified: trunk/abcl/doc/design/amop/dictionary.markdown ============================================================================== --- trunk/abcl/doc/design/amop/dictionary.markdown Mon Jul 4 07:03:43 2011 (r13374) +++ trunk/abcl/doc/design/amop/dictionary.markdown Mon Jul 4 07:03:52 2011 (r13375) @@ -37,7 +37,6 @@ remove-direct-method specializer method remove-direct-subclass superclass subclass remove-method generic-function method -set-funcallable-instance-function funcallable-instance function slot-boundp-using-class class object slot slot-makunbound-using-class class object slot @@ -107,3 +106,4 @@ (setf class-name) new-name class (setf generic-function-name) new-name generic-function (setf slot-value-using-class) new-value class object slot +set-funcallable-instance-function funcallable-instance function From mevenson at common-lisp.net Mon Jul 4 14:04:03 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Mon, 04 Jul 2011 07:04:03 -0700 Subject: [armedbear-cvs] r13376 - in trunk/abcl: src/org/armedbear/lisp test/lisp/abcl Message-ID: Author: mevenson Date: Mon Jul 4 07:04:02 2011 New Revision: 13376 Log: Implement MOP:VALIDATE-SUPERCLASS. Start breaking out MOP defintions into separate 'mop.lisp' file. Added: trunk/abcl/src/org/armedbear/lisp/mop.lisp Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp trunk/abcl/src/org/armedbear/lisp/compile-system.lisp trunk/abcl/test/lisp/abcl/mop-tests.lisp Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/clos.lisp Mon Jul 4 07:03:52 2011 (r13375) +++ trunk/abcl/src/org/armedbear/lisp/clos.lisp Mon Jul 4 07:04:02 2011 (r13376) @@ -3172,4 +3172,8 @@ (defmethod class-prototype ((class structure-class)) (allocate-instance class)) +(eval-when (:compile-toplevel :load-toplevel :execute) + (require "MOP")) + (provide 'clos) + Modified: trunk/abcl/src/org/armedbear/lisp/compile-system.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/compile-system.lisp Mon Jul 4 07:03:52 2011 (r13375) +++ trunk/abcl/src/org/armedbear/lisp/compile-system.lisp Mon Jul 4 07:04:02 2011 (r13376) @@ -107,6 +107,7 @@ (load (do-compile "require.lisp")) (load (do-compile "substitute.lisp")) (load (do-compile "clos.lisp")) + (load (do-compile "mop.lisp")) ;; Order matters for these files. (mapc #'do-compile '("collect.lisp" "macros.lisp" Added: trunk/abcl/src/org/armedbear/lisp/mop.lisp ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ trunk/abcl/src/org/armedbear/lisp/mop.lisp Mon Jul 4 07:04:02 2011 (r13376) @@ -0,0 +1,42 @@ +;;;; Does not currently include all the MOP, but it should. + +(in-package #:mop) + +(defclass funcallable-standard-class (class)) + +(defmethod class-name ((class funcallable-standard-class)) + 'funcallable-standard-class) + +;;; StandardGenericFunction.java defines FUNCALLABLE-INSTANCE-FUNCTION and +;;; SET-FUNCALLABLE-INSTANCE-FUNCTION. +;;; +;;; TODO +;;; +;;; 1. Verify that we can make FUNCALLABLE-STANDARD-CLASS instances +;;; which work. +;;; +;;; 2. Tighten the type checks so that only instances of +;;; FUNCALLABLE-STANDARD-CLASS are callable. + +(defgeneric validate-superclass (class superclass) + (:documentation + "This generic function is called to determine whether the class + superclass is suitable for use as a superclass of class.")) + +(defmethod validate-superclass ((class class) (superclass class)) + (or (eql (class-name superclass) t) + (eql (class-name class) (class-name superclass)) + (or (and (eql (class-name class) 'standard-class) + (eql (class-name superclass) 'funcallable-standard-class)) + (and (eql (class-name class) 'funcallable-standard-class) + (eql (class-name superclass) 'standard-class))))) + +(export '(funcallable-standard-class + validate-superclass)) + +(provide 'mop) + + + + + Modified: trunk/abcl/test/lisp/abcl/mop-tests.lisp ============================================================================== --- trunk/abcl/test/lisp/abcl/mop-tests.lisp Mon Jul 4 07:03:52 2011 (r13375) +++ trunk/abcl/test/lisp/abcl/mop-tests.lisp Mon Jul 4 07:04:02 2011 (r13376) @@ -360,3 +360,14 @@ 1) +(defclass foo-class (standard-class)) +(defmethod mop:validate-superclass ((class foo-class) (superclass standard-object)) + t) + +(deftest validate-superclass.1 + (mop:validate-superclass + (make-instance 'foo-class) + (make-instance 'standard-object)) + t) + + From mevenson at common-lisp.net Mon Jul 4 15:16:47 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Mon, 04 Jul 2011 08:16:47 -0700 Subject: [armedbear-cvs] r13377 - in trunk/abcl: doc/design/amop src/org/armedbear/lisp Message-ID: Author: mevenson Date: Mon Jul 4 08:16:46 2011 New Revision: 13377 Log: Export symbols which are in the AMOP dictionary. design/amop/missing.markdown contains the missing symbols discovered by running APROPOS on a live ABCL image. Added: trunk/abcl/doc/design/amop/missing.markdown Modified: trunk/abcl/doc/design/amop/dictionary.markdown trunk/abcl/src/org/armedbear/lisp/mop.lisp Modified: trunk/abcl/doc/design/amop/dictionary.markdown ============================================================================== --- trunk/abcl/doc/design/amop/dictionary.markdown Mon Jul 4 07:04:02 2011 (r13376) +++ trunk/abcl/doc/design/amop/dictionary.markdown Mon Jul 4 08:16:46 2011 (r13377) @@ -5,14 +5,11 @@ add-dependent metaobject dependent add-direct-method specializer method add-direct-subclass superclass subclass -add-direct-method specializer method -add-direct-subclass superclass subclass add-method generic-function method allocate-instance class &rest initargs compute-applicable-methods generic-function arguments compute-applicable-methods-using-classes generic-function classes -compute-applicable-methods-using-classes generic-function classes compute-class-precedence-list class compute-default-initargs class compute-discriminating-function generic-function @@ -24,10 +21,9 @@ ensure-class-using-class class name &key direct-default-initargs direct-slots direct-superclasses name metaclass &allow-other-keys -ensure-generic-function-using-class generic-function function-name &key argument-precedence-order -declarations documentation generic-function-class lambda-list method-class method-combination -name &allow-other-keys +ensure-generic-function-using-class generic-function function-name &key argument-precedence-order declarations documentation generic-function-class lambda-list method-class method-combination name &allow-other-keys find-method-combination generic-function method-combination-type-name method-combination-options +finalize-inheritance class make-method-lambda generic-function method lambda-expression environment map-dependents metaobject function @@ -68,7 +64,8 @@ generic-function-lambda-list generic-function generic-function-method-class generic-function generic-function-method-combination generic-function -generic-function-methods and generic-function-name generic-function +generic-function-methods generic-function +generic-function-name generic-function ## Readers for Method Metaobjects Added: trunk/abcl/doc/design/amop/missing.markdown ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ trunk/abcl/doc/design/amop/missing.markdown Mon Jul 4 08:16:46 2011 (r13377) @@ -0,0 +1,78 @@ +# Missing AMOP symbols + +add-dependent + +add-direct-method + +add-direct-subclass + +compute-class-precedence-list + +compute-default-initargs + +compute-discriminating-function + +compute-effective-method + + We have COMPUTE-EFFECTIVE-METHOD-FUNCTION which lacks the + METHOD-COMBINATION argument in its signature. + +ensure-class-using-class + +ensure-generic-function-using-class + +find-method-combination + +make-method-lambda + +map-dependents + +reader-method-class + +remove-dependent + +remove-direct-method + +remove-direct-subclass + +specializer-direct-generic-functions + +specializer-direct-methods + +standard-instance-access + Present in SYSTEM. + +update-dependent + +writer-method-class + +generic-function-argument-precedence-order + Present in SYSTEM. + +generic-function-declarations + +generic-function-method-class + Present in SYSTEM. + +generic-function-method-combination + Present in SYSTEM. + +generic-function-methods + Present in SYSTEM. + +method-generic-function + +method-lambda-list + Present in SYSTEM. + +accessor-method-slot-definition + +slot-definition-type + +ensure-class + Present in SYSTEM. + +extract-specializer-names + +funcallable-standard-instance-access + Modified: trunk/abcl/src/org/armedbear/lisp/mop.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/mop.lisp Mon Jul 4 07:04:02 2011 (r13376) +++ trunk/abcl/src/org/armedbear/lisp/mop.lisp Mon Jul 4 08:16:46 2011 (r13377) @@ -32,7 +32,36 @@ (eql (class-name superclass) 'standard-class))))) (export '(funcallable-standard-class - validate-superclass)) + validate-superclass + direct-slot-definition-class + effective-slot-definition-class + compute-effective-slot-definition + compute-class-precedence-list + compute-effective-slot-definition + compute-slots + finalize-inheritance + slot-boundp-using-class + slot-makunbound-using-class + + class-default-initargs + class-direct-default-initargs + class-direct-slots + class-direct-subclasses + class-direct-superclasses + class-finalized-p + class-prototype + + generic-function-lambda-list + + method-function + + slot-definition-readers + slot-definition-writers + + eql-specializer-object + extract-lambda-list + + intern-eql-specializer)) (provide 'mop) From mevenson at common-lisp.net Tue Jul 5 09:34:00 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 05 Jul 2011 02:34:00 -0700 Subject: [armedbear-cvs] r13378 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: mevenson Date: Tue Jul 5 02:33:59 2011 New Revision: 13378 Log: PRINT-OBJECT shouldn't repeat the identity twice for STANDARD-OBJECT. Modified: trunk/abcl/src/org/armedbear/lisp/print-object.lisp Modified: trunk/abcl/src/org/armedbear/lisp/print-object.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/print-object.lisp Mon Jul 4 08:16:46 2011 (r13377) +++ trunk/abcl/src/org/armedbear/lisp/print-object.lisp Tue Jul 5 02:33:59 2011 (r13378) @@ -42,6 +42,9 @@ (print-unreadable-object (object stream :type t :identity t) (write-string (%write-to-string object) stream))) +(defmethod print-object ((object standard-object) stream) + (write-string (%write-to-string object) stream)) + (defmethod print-object ((object structure-object) stream) (write-string (%write-to-string object) stream)) From mevenson at common-lisp.net Tue Jul 5 09:34:08 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 05 Jul 2011 02:34:08 -0700 Subject: [armedbear-cvs] r13379 - trunk/abcl/doc/design/amop Message-ID: Author: mevenson Date: Tue Jul 5 02:34:08 2011 New Revision: 13379 Log: Note the presence of possible canidate for method-generic-function. Modified: trunk/abcl/doc/design/amop/missing.markdown Modified: trunk/abcl/doc/design/amop/missing.markdown ============================================================================== --- trunk/abcl/doc/design/amop/missing.markdown Tue Jul 5 02:33:59 2011 (r13378) +++ trunk/abcl/doc/design/amop/missing.markdown Tue Jul 5 02:34:08 2011 (r13379) @@ -61,6 +61,7 @@ Present in SYSTEM. method-generic-function + Check %method-generic-function method-lambda-list Present in SYSTEM. From mevenson at common-lisp.net Fri Jul 8 08:40:38 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 08 Jul 2011 01:40:38 -0700 Subject: [armedbear-cvs] r13380 - in trunk/abcl: src/org/armedbear/lisp test/lisp/abcl Message-ID: 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 From ehuelsmann at common-lisp.net Sat Jul 9 22:49:05 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sat, 09 Jul 2011 15:49:05 -0700 Subject: [armedbear-cvs] r13381 - trunk/abcl Message-ID: Author: ehuelsmann Date: Sat Jul 9 15:49:04 2011 New Revision: 13381 Log: Update CHANGES with 0.26.0 items. Modified: trunk/abcl/CHANGES Modified: trunk/abcl/CHANGES ============================================================================== --- trunk/abcl/CHANGES Fri Jul 8 01:40:37 2011 (r13380) +++ trunk/abcl/CHANGES Sat Jul 9 15:49:04 2011 (r13381) @@ -1,3 +1,91 @@ +Version 0.26.0 +============== +svn://common-lisp.net/project/armedbear/svn/tags/0.26.0/abcl +(?? ???? 2011) + +Features +-------- + + * Add support for weak reference objects + + * Add support for finalizers on LispObject derived classes + + * Upgrade ASDF to 2.0.16.1 + + * #\ reader macro now understands #\uNNNN as unicode codepoints + + * JAVA:JRESOLVE-METHOD returns same method as would have been + called by JAVA:JCALL with the same arguments + + * Ant 'update' target to upload application to Google App Engine + + * Simple RUN-PROGRAM implementation + + * Support for custom slot definitions according to AMOP + + * New JAVA:*JAVA-OBJECT-TO-STRING-LENGTH* variable to control pretty + printing of Java objects + + * JSS - more dynamic Lisp/Java FFI - (http://lsw2.googlecode.com/svn/trunk) + imported + + * (REQUIRE :ABCL-CONTRIB) adds 'abcl-contrib.jar' to the ASDF search path + + * Support for weak references in hash tables through a :WEAKNESS keyword + argument to MAKE-HASH-TABLE; with SYS:HASH-TABLE-WEAKNESS for inspection + + * Support for loading ASDF systems from JAR archives + + * Fast SHA1, SHA256 and SHA512 cryptographic hashes for files + + * Beginnings of a manual + + * ABCL/ASDF integration with Maven provided systems + + * ASDF-JAR:PACKAGE function to package ASDF systems into JARs + +Changes +======= + + * Reduced code size in the compiler by changing COMPILE-TEST-FORM + + * Enhanced SLIME inspector for JAVA:JAVA-OBJECT + + * Reimplemented MERGE-PATHNAMES + + * TRANSLATE-PATHNAME aligned with SBCL's behaviour if version is wild + + * Removed PRINT-OBJECT methods duplicating Java side code + + * Refactored code in SYSTEM:ZIP function + + * Allow JCOERCE to convert any number to java.lang.Byte (using + its two's complement) + + * Replace MAKE-IMMEDIATE-OBJECT with +NULL+, +TRUE+ and +FALSE+ constants + (the only supported ones) + + * Better separation between java-collections package and Java FFI + + * JAVA:ADD-TO-CLASSPATH is now a generic function + +Fixes +===== + + * Google App Engine example fixed + + * MAKE-PATHNAME erroneously merges directories as in MERGE-PATHNAME + + * Pretty printer routines using SYS:OUTPUT-OBJECT with GRAY-STREAM + + * Value of *PRINT-CASE* affects file (to FASL) compilation + + * MAKE-PATHNAME ignores version in :DEFAULTS + + * URI decoding algorithm in Pathname.java + + * JNEW-ARRAY-FROM-ARRAY should create byte[] arrays + Version 0.25.0 ============== svn://common-lisp.net/project/armedbear/svn/tags/0.25.0/abcl From ehuelsmann at common-lisp.net Sat Jul 9 22:51:24 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sat, 09 Jul 2011 15:51:24 -0700 Subject: [armedbear-cvs] r13382 - branches/0.26.x Message-ID: Author: ehuelsmann Date: Sat Jul 9 15:51:24 2011 New Revision: 13382 Log: Create 0.26 release branch. Added: branches/0.26.x/ - copied from r13381, trunk/ From ehuelsmann at common-lisp.net Sat Jul 9 22:57:26 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sat, 09 Jul 2011 15:57:26 -0700 Subject: [armedbear-cvs] r13383 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sat Jul 9 15:57:25 2011 New Revision: 13383 Log: Increase trunk version number. Modified: trunk/abcl/src/org/armedbear/lisp/Version.java Modified: trunk/abcl/src/org/armedbear/lisp/Version.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Version.java Sat Jul 9 15:51:24 2011 (r13382) +++ trunk/abcl/src/org/armedbear/lisp/Version.java Sat Jul 9 15:57:25 2011 (r13383) @@ -41,7 +41,7 @@ { private Version() {} - static final String baseVersion = "0.26.0-dev"; + static final String baseVersion = "0.27.0-dev"; static void init() { try { From ehuelsmann at common-lisp.net Sat Jul 9 22:58:42 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sat, 09 Jul 2011 15:58:42 -0700 Subject: [armedbear-cvs] r13384 - trunk/abcl Message-ID: Author: ehuelsmann Date: Sat Jul 9 15:58:42 2011 New Revision: 13384 Log: Set release date in CHANGES. Modified: trunk/abcl/CHANGES Modified: trunk/abcl/CHANGES ============================================================================== --- trunk/abcl/CHANGES Sat Jul 9 15:57:25 2011 (r13383) +++ trunk/abcl/CHANGES Sat Jul 9 15:58:42 2011 (r13384) @@ -1,7 +1,7 @@ Version 0.26.0 ============== svn://common-lisp.net/project/armedbear/svn/tags/0.26.0/abcl -(?? ???? 2011) +(10 July 2011) Features -------- From ehuelsmann at common-lisp.net Sat Jul 9 22:59:20 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sat, 09 Jul 2011 15:59:20 -0700 Subject: [armedbear-cvs] r13385 - branches/0.26.x/abcl Message-ID: Author: ehuelsmann Date: Sat Jul 9 15:59:20 2011 New Revision: 13385 Log: Set release date in CHANGES. Modified: branches/0.26.x/abcl/CHANGES Modified: branches/0.26.x/abcl/CHANGES ============================================================================== --- branches/0.26.x/abcl/CHANGES Sat Jul 9 15:58:42 2011 (r13384) +++ branches/0.26.x/abcl/CHANGES Sat Jul 9 15:59:20 2011 (r13385) @@ -1,7 +1,7 @@ Version 0.26.0 ============== svn://common-lisp.net/project/armedbear/svn/tags/0.26.0/abcl -(?? ???? 2011) +(10 July 2011) Features -------- From ehuelsmann at common-lisp.net Sat Jul 9 23:00:56 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sat, 09 Jul 2011 16:00:56 -0700 Subject: [armedbear-cvs] r13386 - in tags/0.26.0: . abcl abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sat Jul 9 16:00:56 2011 New Revision: 13386 Log: Create 0.26.0 tag. Added: tags/0.26.0/ - copied from r13383, branches/0.26.x/ Replaced: tags/0.26.0/abcl/ - copied from r13385, branches/0.26.x/abcl/ Modified: tags/0.26.0/abcl/src/org/armedbear/lisp/Version.java Modified: tags/0.26.0/abcl/src/org/armedbear/lisp/Version.java ============================================================================== --- branches/0.26.x/abcl/src/org/armedbear/lisp/Version.java Sat Jul 9 15:59:20 2011 (r13385) +++ tags/0.26.0/abcl/src/org/armedbear/lisp/Version.java Sat Jul 9 16:00:56 2011 (r13386) @@ -41,7 +41,7 @@ { private Version() {} - static final String baseVersion = "0.26.0-dev"; + static final String baseVersion = "0.26.0"; static void init() { try { From ehuelsmann at common-lisp.net Sat Jul 9 23:01:55 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sat, 09 Jul 2011 16:01:55 -0700 Subject: [armedbear-cvs] r13387 - branches/0.26.x/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sat Jul 9 16:01:54 2011 New Revision: 13387 Log: Increase branch version number to 0.26.1-dev. Modified: branches/0.26.x/abcl/src/org/armedbear/lisp/Version.java Modified: branches/0.26.x/abcl/src/org/armedbear/lisp/Version.java ============================================================================== --- branches/0.26.x/abcl/src/org/armedbear/lisp/Version.java Sat Jul 9 16:00:56 2011 (r13386) +++ branches/0.26.x/abcl/src/org/armedbear/lisp/Version.java Sat Jul 9 16:01:54 2011 (r13387) @@ -41,7 +41,7 @@ { private Version() {} - static final String baseVersion = "0.26.0-dev"; + static final String baseVersion = "0.26.1-dev"; static void init() { try { From ehuelsmann at common-lisp.net Sun Jul 10 08:04:03 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sun, 10 Jul 2011 01:04:03 -0700 Subject: [armedbear-cvs] r13388 - public_html/releases/0.26.0 Message-ID: Author: ehuelsmann Date: Sun Jul 10 01:03:58 2011 New Revision: 13388 Log: Uploading 0.26.0. Added: public_html/releases/0.26.0/ (props changed) public_html/releases/0.26.0/abcl-bin-0.26.0.tar.gz (contents, props changed) public_html/releases/0.26.0/abcl-bin-0.26.0.zip (contents, props changed) public_html/releases/0.26.0/abcl-src-0.26.0.tar.gz (contents, props changed) public_html/releases/0.26.0/abcl-src-0.26.0.zip (contents, props changed) Added: public_html/releases/0.26.0/abcl-bin-0.26.0.tar.gz ============================================================================== Binary file. No diff available. Added: public_html/releases/0.26.0/abcl-bin-0.26.0.zip ============================================================================== Binary file. No diff available. Added: public_html/releases/0.26.0/abcl-src-0.26.0.tar.gz ============================================================================== Binary file. No diff available. Added: public_html/releases/0.26.0/abcl-src-0.26.0.zip ============================================================================== Binary file. No diff available. From ehuelsmann at common-lisp.net Sun Jul 10 08:22:17 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sun, 10 Jul 2011 01:22:17 -0700 Subject: [armedbear-cvs] r13389 - public_html/releases/0.26.0 Message-ID: Author: ehuelsmann Date: Sun Jul 10 01:22:16 2011 New Revision: 13389 Log: Add signature files. Added: public_html/releases/0.26.0/abcl-bin-0.26.0.tar.gz.asc public_html/releases/0.26.0/abcl-bin-0.26.0.zip.asc public_html/releases/0.26.0/abcl-src-0.26.0.tar.gz.asc public_html/releases/0.26.0/abcl-src-0.26.0.zip.asc Added: public_html/releases/0.26.0/abcl-bin-0.26.0.tar.gz.asc ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ public_html/releases/0.26.0/abcl-bin-0.26.0.tar.gz.asc Sun Jul 10 01:22:16 2011 (r13389) @@ -0,0 +1,7 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.9 (GNU/Linux) + +iEYEABECAAYFAk4ZXjwACgkQi5O0Epaz9TmoiQCfawDae35HIQAtElQFH8KqHaTY +thkAn1t+JcVEAziRbIFPH83Ec5CMciBu +=a68E +-----END PGP SIGNATURE----- Added: public_html/releases/0.26.0/abcl-bin-0.26.0.zip.asc ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ public_html/releases/0.26.0/abcl-bin-0.26.0.zip.asc Sun Jul 10 01:22:16 2011 (r13389) @@ -0,0 +1,7 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.9 (GNU/Linux) + +iEYEABECAAYFAk4ZXkQACgkQi5O0Epaz9TnYVwCeNhAOReuEagfUtQK2pxo4habz +9IMAnjBtZGPkmglzhgkyxFRWXyc6ZVkg +=r6RU +-----END PGP SIGNATURE----- Added: public_html/releases/0.26.0/abcl-src-0.26.0.tar.gz.asc ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ public_html/releases/0.26.0/abcl-src-0.26.0.tar.gz.asc Sun Jul 10 01:22:16 2011 (r13389) @@ -0,0 +1,7 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.9 (GNU/Linux) + +iEYEABECAAYFAk4ZXkgACgkQi5O0Epaz9TkGUQCfYG1k+EglQdCuQku6RqJaeqo8 +5HgAn3GziZJIAQ7jyJuHMeGDvPDIT/Kv +=o+xE +-----END PGP SIGNATURE----- Added: public_html/releases/0.26.0/abcl-src-0.26.0.zip.asc ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ public_html/releases/0.26.0/abcl-src-0.26.0.zip.asc Sun Jul 10 01:22:16 2011 (r13389) @@ -0,0 +1,7 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.9 (GNU/Linux) + +iEYEABECAAYFAk4ZXk8ACgkQi5O0Epaz9TnK0wCdEsGQLNZ3EQQnSft76r4jWAT4 +BPoAnjVGw6IqAqbC47MrpKAqnKy6Q0Wu +=rimw +-----END PGP SIGNATURE----- From mevenson at common-lisp.net Mon Jul 11 12:14:11 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Mon, 11 Jul 2011 05:14:11 -0700 Subject: [armedbear-cvs] r13390 - trunk/abcl Message-ID: Author: mevenson Date: Mon Jul 11 05:14:08 2011 New Revision: 13390 Log: Include org.armedbear.lisp.protocol source in release. Modified: trunk/abcl/build.xml Modified: trunk/abcl/build.xml ============================================================================== --- trunk/abcl/build.xml Sun Jul 10 01:22:16 2011 (r13389) +++ trunk/abcl/build.xml Mon Jul 11 05:14:08 2011 (r13390) @@ -58,6 +58,7 @@ + From mevenson at common-lisp.net Mon Jul 11 12:18:17 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Mon, 11 Jul 2011 05:18:17 -0700 Subject: [armedbear-cvs] r13391 - branches/0.26.x/abcl Message-ID: Author: mevenson Date: Mon Jul 11 05:18:17 2011 New Revision: 13391 Log: Backport r13390: Include org.armedbear.lisp.protocol source in release. Modified: branches/0.26.x/abcl/build.xml Modified: branches/0.26.x/abcl/build.xml ============================================================================== --- branches/0.26.x/abcl/build.xml Mon Jul 11 05:14:08 2011 (r13390) +++ branches/0.26.x/abcl/build.xml Mon Jul 11 05:18:17 2011 (r13391) @@ -58,6 +58,7 @@ + From mevenson at common-lisp.net Mon Jul 11 12:19:43 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Mon, 11 Jul 2011 05:19:43 -0700 Subject: [armedbear-cvs] r13392 - branches/0.26.x/abcl Message-ID: Author: mevenson Date: Mon Jul 11 05:19:43 2011 New Revision: 13392 Log: Note backport of compilation fix in CHANGES. Modified: branches/0.26.x/abcl/CHANGES Modified: branches/0.26.x/abcl/CHANGES ============================================================================== --- branches/0.26.x/abcl/CHANGES Mon Jul 11 05:18:17 2011 (r13391) +++ branches/0.26.x/abcl/CHANGES Mon Jul 11 05:19:43 2011 (r13392) @@ -1,3 +1,13 @@ +Version 0.26.1 +============== +svn://common-lisp.net/project/armedbear/svn/tags/0.26.1/abcl + +Fixes +----- + + * Fix compilation problems by including the + org.armedbear.lisp.protocol source in the build process. + Version 0.26.0 ============== svn://common-lisp.net/project/armedbear/svn/tags/0.26.0/abcl From mevenson at common-lisp.net Mon Jul 11 13:57:05 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Mon, 11 Jul 2011 06:57:05 -0700 Subject: [armedbear-cvs] r13393 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: mevenson Date: Mon Jul 11 06:57:04 2011 New Revision: 13393 Log: JAVA:JARRAY-FROM-LIST infers the type of the Java array. Modified: trunk/abcl/src/org/armedbear/lisp/java.lisp Modified: trunk/abcl/src/org/armedbear/lisp/java.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/java.lisp Mon Jul 11 05:19:43 2011 (r13392) +++ trunk/abcl/src/org/armedbear/lisp/java.lisp Mon Jul 11 06:57:04 2011 (r13393) @@ -223,6 +223,14 @@ i (1+ i))) jarray)) +(defun jarray-from-list (list) + "Return a Java array from LIST whose type is inferred from the first element. + +For more control over the type of the array, use JNEW-ARRAY-FROM-LIST." + (jnew-array-from-list + (jobject-class (first list)) + list)) + (defun list-from-jarray (jarray) "Returns a list with the elements of `jarray`." (loop for i from 0 below (jarray-length jarray) From mevenson at common-lisp.net Mon Jul 11 13:57:22 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Mon, 11 Jul 2011 06:57:22 -0700 Subject: [armedbear-cvs] r13394 - trunk/abcl/contrib/jss Message-ID: Author: mevenson Date: Mon Jul 11 06:57:21 2011 New Revision: 13394 Log: Ensure that ASDF jar-file always loaded when encountered. JSS:NEW is no longer deprecated. Documentation improvements. Update to version jss-2.1.0. Modified: trunk/abcl/contrib/jss/README.markdown trunk/abcl/contrib/jss/asdf-jar.lisp trunk/abcl/contrib/jss/jss.asd trunk/abcl/contrib/jss/packages.lisp Modified: trunk/abcl/contrib/jss/README.markdown ============================================================================== --- trunk/abcl/contrib/jss/README.markdown Mon Jul 11 06:57:04 2011 (r13393) +++ trunk/abcl/contrib/jss/README.markdown Mon Jul 11 06:57:21 2011 (r13394) @@ -29,29 +29,61 @@ recorded that b.c.d, b.C.d, C.d, c.d, and d potentially refer to this class. In your call to new, as long as the symbol can refer to only one class, we use that class. In this case, it is -java.io.StringWriter. You could also have written (new -'io.stringwriter), (new '|io.StringWriter|), (new -'java.io.StringWriter)... - -the call (#"write" sw "Hello "), uses the code in invoke.java to -call the method named "write" with the arguments sw and "Hello ". -JSS figures out the right java method to call, and calls it. +java.io.StringWriter. You could also have written + + (new 'io.stringwriter) + +or + (new '|io.StringWriter|) + +or + (new 'java.io.StringWriter) + +The call + + (#"write" sw "Hello ") + +uses the code in invoke.java to call the method named "write" with +the arguments sw and "Hello ". JSS figures out the right java method +to call, and calls it. + +Static calls are possible as well with the #" macro, but the +first argument MUST BE A SYMBOL to distinguish + + (#"getProperties" "java.lang.System") + +from + + (#"getProperties" 'java.lang.System) + +The first attempts to call a method on the java.lang.String object +with the contents "java.lang.System", which results in an error, while +the second invokes the static java.lang.System.getProperties() method. If you want to do a raw java call, use #0"toString". Raw calls return their results as Java objects, avoiding doing the usual Java object to Lisp object conversions that ABCL does. -(with-constant-signature ((name jname raw?)*) &body body) + + (with-constant-signature ((name jname raw?)*) &body body) + binds a macro which expands to a jcall, promising that the same method will be called every time. Use this if you are making a lot of calls and want to avoid the overhead of a the dynamic dispatch. -e.g. (with-constant-signature ((tostring "toString")) +e.g. + + (with-constant-signature ((tostring "toString")) (time (dotimes (i 10000) (tostring "foo")))) -runs about 3x faster than (time (dotimes (i 10000) (#"toString" "foo"))) -(with-constant-signature ((tostring "toString" t)) ...) will cause the -toString to be a raw java call. see get-all-jar-classnames below for -an example. +runs about three times faster than + + (time (dotimes (i 10000) (#"toString" "foo"))) + + + (with-constant-signature ((tostring "toString" t)) ...) + +will cause the toString to be a raw java call. See +JSS::GET-ALL-JAR-CLASSNAMES for an example. Implementation is that the first time the function is called, the method is looked up based on the arguments passed, and thereafter @@ -61,3 +93,19 @@ (japropos string) finds all class names matching string (jcmn class-name) lists the names of all methods for the class + + +Compatibility +------------- + +The function ENSURE-COMPATIBILITY attempts to provide a compatibility +mode to existing users of JSS by importing the necessary symbols into +CL-USER. + +Some notes on other compatibilty issues: + +*classpath-manager* + + Since we are no longer using Beanshell, this is no longer present. + For obtaining the current classloader use JAVA:*CLASSLOADER*. + Modified: trunk/abcl/contrib/jss/asdf-jar.lisp ============================================================================== --- trunk/abcl/contrib/jss/asdf-jar.lisp Mon Jul 11 06:57:04 2011 (r13393) +++ trunk/abcl/contrib/jss/asdf-jar.lisp Mon Jul 11 06:57:21 2011 (r13394) @@ -24,11 +24,9 @@ (defmethod perform ((operation load-op) (c jar-file)) (or jss:*inhibit-add-to-classpath* - (jss::add-to-classpath (component-pathname c)))) + (jss:add-to-classpath (component-pathname c)))) (defmethod operation-done-p ((operation load-op) (c jar-file)) - t -#+nil (or jss:*inhibit-add-to-classpath* (member (namestring (truename (component-pathname c))) jss:*added-to-classpath* :test 'equal))) Modified: trunk/abcl/contrib/jss/jss.asd ============================================================================== --- trunk/abcl/contrib/jss/jss.asd Mon Jul 11 06:57:04 2011 (r13393) +++ trunk/abcl/contrib/jss/jss.asd Mon Jul 11 06:57:21 2011 (r13394) @@ -3,7 +3,7 @@ (defsystem :jss :author "Alan Ruttenberg, Mark Evenson" - :version "2.0.1" + :version "2.1.0" :components ((:module base :pathname "" :serial t :components ((:file "packages") Modified: trunk/abcl/contrib/jss/packages.lisp ============================================================================== --- trunk/abcl/contrib/jss/packages.lisp Mon Jul 11 06:57:04 2011 (r13393) +++ trunk/abcl/contrib/jss/packages.lisp Mon Jul 11 06:57:21 2011 (r13394) @@ -16,6 +16,7 @@ #:need-to-add-directory-jar? #:jcmn #:japropos + #:new ;;; Useful utilities to convert common Java items to Lisp counterparts #:hashmap-to-hashtable @@ -25,7 +26,7 @@ #:vector-to-list ;;; deprecated - #:new ; use JAVA:NEW + #:get-java-field ; use JAVA:JFIELD ;;; Move to JAVA? From mevenson at common-lisp.net Tue Jul 12 08:26:48 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 12 Jul 2011 01:26:48 -0700 Subject: [armedbear-cvs] r13395 - trunk/abcl Message-ID: Author: mevenson Date: Tue Jul 12 01:26:48 2011 New Revision: 13395 Log: Correct mispellings. Modified: trunk/abcl/build.xml Modified: trunk/abcl/build.xml ============================================================================== --- trunk/abcl/build.xml Mon Jul 11 06:57:21 2011 (r13394) +++ trunk/abcl/build.xml Tue Jul 12 01:26:48 2011 (r13395) @@ -783,7 +783,7 @@ [1]: svn://common-lisp.net/project/ansi-test/svn/trunk/ansi-tests -The CL-BENCH test require that [cl-bench][2] be maunally installed in +The CL-BENCH tests require that [cl-bench][2] be manually installed in ${basedir}/../cl-bench [2]: http://www.chez.com/emarsden/downloads/cl-bench.tar.gz From mevenson at common-lisp.net Tue Jul 12 08:51:08 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 12 Jul 2011 01:51:08 -0700 Subject: [armedbear-cvs] r13396 - trunk/abcl/contrib/jss Message-ID: Author: mevenson Date: Tue Jul 12 01:51:08 2011 New Revision: 13396 Log: Correct my dyslexic spelling to ENSURE-COMPATIBILITY. Modified: trunk/abcl/contrib/jss/compat.lisp trunk/abcl/contrib/jss/jss.asd trunk/abcl/contrib/jss/packages.lisp Modified: trunk/abcl/contrib/jss/compat.lisp ============================================================================== --- trunk/abcl/contrib/jss/compat.lisp Tue Jul 12 01:26:48 2011 (r13395) +++ trunk/abcl/contrib/jss/compat.lisp Tue Jul 12 01:51:08 2011 (r13396) @@ -1,9 +1,9 @@ (in-package :jss) (defparameter *cl-user-compatibility* nil - "Whether backwards compatiblity with JSS's use of CL-USER has been enabled.") + "Whether backwards compatibility with JSS's use of CL-USER has been enabled.") -(defun ensure-compatiblity () +(defun ensure-compatibility () (setf *cl-user-compatibility* t) (let ((dont-export '(add-to-classpath *cl-user-compatibility*))) (loop :for symbol :being :each :external-symbol :in :jss Modified: trunk/abcl/contrib/jss/jss.asd ============================================================================== --- trunk/abcl/contrib/jss/jss.asd Tue Jul 12 01:26:48 2011 (r13395) +++ trunk/abcl/contrib/jss/jss.asd Tue Jul 12 01:51:08 2011 (r13396) @@ -3,7 +3,7 @@ (defsystem :jss :author "Alan Ruttenberg, Mark Evenson" - :version "2.1.0" + :version "2.1.1" :components ((:module base :pathname "" :serial t :components ((:file "packages") Modified: trunk/abcl/contrib/jss/packages.lisp ============================================================================== --- trunk/abcl/contrib/jss/packages.lisp Tue Jul 12 01:26:48 2011 (r13395) +++ trunk/abcl/contrib/jss/packages.lisp Tue Jul 12 01:51:08 2011 (r13396) @@ -34,6 +34,6 @@ ;;; Enable compatibility with jss-1.0 by placing symbols in CL-USER - #:ensure-compatiblity #:*cl-user-compatibility*) + #:ensure-compatibility #:*cl-user-compatibility*) (:shadow #:add-to-classpath)) From mevenson at common-lisp.net Tue Jul 12 09:21:59 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 12 Jul 2011 02:21:59 -0700 Subject: [armedbear-cvs] r13397 - trunk/abcl/contrib/jss Message-ID: Author: mevenson Date: Tue Jul 12 02:21:59 2011 New Revision: 13397 Log: Rename as JSS:JLIST-TO-LIST to align with JAVA conventions. Modified: trunk/abcl/contrib/jss/invoke.lisp trunk/abcl/contrib/jss/jss.asd trunk/abcl/contrib/jss/packages.lisp Modified: trunk/abcl/contrib/jss/invoke.lisp ============================================================================== --- trunk/abcl/contrib/jss/invoke.lisp Tue Jul 12 01:51:08 2011 (r13396) +++ trunk/abcl/contrib/jss/invoke.lisp Tue Jul 12 02:21:59 2011 (r13397) @@ -550,7 +550,7 @@ for item = (next iterator) collect item))) -(defun list-to-list (list) +(defun jlist-to-list (list) (declare (optimize (speed 3) (safety 0))) (with-constant-signature ((isEmpty "isEmpty") (getfirst "getFirst") (getNext "getNext")) @@ -558,6 +558,9 @@ collect (getFirst list) do (setq list (getNext list))))) +;;; Deprecated +(setf (symbol-function 'list-to-list) #'jlist-to-list) + ;; Contribution of Luke Hope. (Thanks!) (defun iterable-to-list (iterable) Modified: trunk/abcl/contrib/jss/jss.asd ============================================================================== --- trunk/abcl/contrib/jss/jss.asd Tue Jul 12 01:51:08 2011 (r13396) +++ trunk/abcl/contrib/jss/jss.asd Tue Jul 12 02:21:59 2011 (r13397) @@ -3,7 +3,7 @@ (defsystem :jss :author "Alan Ruttenberg, Mark Evenson" - :version "2.1.1" + :version "2.2.0" :components ((:module base :pathname "" :serial t :components ((:file "packages") Modified: trunk/abcl/contrib/jss/packages.lisp ============================================================================== --- trunk/abcl/contrib/jss/packages.lisp Tue Jul 12 01:51:08 2011 (r13396) +++ trunk/abcl/contrib/jss/packages.lisp Tue Jul 12 02:21:59 2011 (r13397) @@ -21,18 +21,17 @@ ;;; Useful utilities to convert common Java items to Lisp counterparts #:hashmap-to-hashtable #:iterable-to-list - #:list-to-list + #:jlist-to-list #:set-to-list #:vector-to-list ;;; deprecated - #:get-java-field ; use JAVA:JFIELD + #:list-to-list ;;; Move to JAVA? #:jclass-all-interfaces - ;;; Enable compatibility with jss-1.0 by placing symbols in CL-USER #:ensure-compatibility #:*cl-user-compatibility*) (:shadow #:add-to-classpath)) From mevenson at common-lisp.net Tue Jul 12 14:28:02 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 12 Jul 2011 07:28:02 -0700 Subject: [armedbear-cvs] r13398 - trunk/abcl/contrib/jss Message-ID: Author: mevenson Date: Tue Jul 12 07:28:01 2011 New Revision: 13398 Log: JSS:JLIST-TO-LIST now works for types implementing java.util.List. Unclear as to what sort of type JSS:LIST-TO-LIST should work on, so we restore the previous implementation while marking it as deprecated. Modified: trunk/abcl/contrib/jss/invoke.lisp trunk/abcl/contrib/jss/packages.lisp Modified: trunk/abcl/contrib/jss/invoke.lisp ============================================================================== --- trunk/abcl/contrib/jss/invoke.lisp Tue Jul 12 02:21:59 2011 (r13397) +++ trunk/abcl/contrib/jss/invoke.lisp Tue Jul 12 07:28:01 2011 (r13398) @@ -551,16 +551,29 @@ collect item))) (defun jlist-to-list (list) + "Convert a LIST implementing java.util.List to a Lisp list." + (declare (optimize (speed 3) (safety 0))) + (loop :for i :from 0 :below (jcall "size" list) + :collecting (jcall "get" list i))) + +(defun jarray-to-list (jarray) + (declare (optimize (speed 3) (safety 0))) + (jlist-to-list + (jstatic "asList" "java.util.Arrays" jarray))) + +;;; Deprecated +;;; +;;; XXX unclear what sort of list this would actually work on, as it +;;; certainly doesn't seem to be any of the Java collection types +;;; (what implements getNext())? +(defun list-to-list (list) (declare (optimize (speed 3) (safety 0))) (with-constant-signature ((isEmpty "isEmpty") (getfirst "getFirst") - (getNext "getNext")) + (getNext "getNext")) (loop until (isEmpty list) collect (getFirst list) do (setq list (getNext list))))) -;;; Deprecated -(setf (symbol-function 'list-to-list) #'jlist-to-list) - ;; Contribution of Luke Hope. (Thanks!) (defun iterable-to-list (iterable) Modified: trunk/abcl/contrib/jss/packages.lisp ============================================================================== --- trunk/abcl/contrib/jss/packages.lisp Tue Jul 12 02:21:59 2011 (r13397) +++ trunk/abcl/contrib/jss/packages.lisp Tue Jul 12 07:28:01 2011 (r13398) @@ -24,6 +24,7 @@ #:jlist-to-list #:set-to-list #:vector-to-list + #:jarray-to-list ;;; deprecated #:get-java-field ; use JAVA:JFIELD From ehuelsmann at common-lisp.net Wed Jul 13 15:31:24 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Wed, 13 Jul 2011 08:31:24 -0700 Subject: [armedbear-cvs] r13399 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Wed Jul 13 08:31:18 2011 New Revision: 13399 Log: Fix #151: Don't call higher level abstractions from low level lisp routines. Modified: trunk/abcl/src/org/armedbear/lisp/StandardObject.java Modified: trunk/abcl/src/org/armedbear/lisp/StandardObject.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/StandardObject.java Tue Jul 12 07:28:01 2011 (r13398) +++ trunk/abcl/src/org/armedbear/lisp/StandardObject.java Wed Jul 13 08:31:18 2011 (r13399) @@ -208,12 +208,6 @@ int currentLevel = Fixnum.getValue(currentPrintLevel); if (currentLevel >= maxLevel) return "#"; - if (typep(Symbol.CONDITION) != NIL) - { - StringOutputStream stream = new StringOutputStream(); - Symbol.PRINT_OBJECT.execute(this, stream); - return stream.getString().getStringValue(); - } return unreadableString(typeOf().writeToString()); } From ehuelsmann at common-lisp.net Wed Jul 13 19:10:50 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Wed, 13 Jul 2011 12:10:50 -0700 Subject: [armedbear-cvs] r13399 - svn:log Message-ID: Author: ehuelsmann Revision: 13399 Property Name: svn:log Action: modified Property diff: --- old property value +++ new property value @@ -1 +1 @@ -Fix #151: Don't call higher level abstractions from low level lisp routines. \ No newline at end of file +Fix #154: Don't call higher level abstractions from low level lisp routines. \ No newline at end of file From ehuelsmann at common-lisp.net Wed Jul 13 19:11:17 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Wed, 13 Jul 2011 12:11:17 -0700 Subject: [armedbear-cvs] r13400 - branches/0.26.x/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Wed Jul 13 12:11:11 2011 New Revision: 13400 Log: Fix #154 on 0.26.x branch: backport r13399. Modified: branches/0.26.x/abcl/src/org/armedbear/lisp/StandardObject.java Modified: branches/0.26.x/abcl/src/org/armedbear/lisp/StandardObject.java ============================================================================== --- branches/0.26.x/abcl/src/org/armedbear/lisp/StandardObject.java Wed Jul 13 08:31:18 2011 (r13399) +++ branches/0.26.x/abcl/src/org/armedbear/lisp/StandardObject.java Wed Jul 13 12:11:11 2011 (r13400) @@ -208,12 +208,6 @@ int currentLevel = Fixnum.getValue(currentPrintLevel); if (currentLevel >= maxLevel) return "#"; - if (typep(Symbol.CONDITION) != NIL) - { - StringOutputStream stream = new StringOutputStream(); - Symbol.PRINT_OBJECT.execute(this, stream); - return stream.getString().getStringValue(); - } return unreadableString(typeOf().writeToString()); } From mevenson at common-lisp.net Thu Jul 14 14:10:12 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 14 Jul 2011 07:10:12 -0700 Subject: [armedbear-cvs] r13401 - trunk/abcl/test/lisp/ansi Message-ID: Author: mevenson Date: Thu Jul 14 07:10:11 2011 New Revision: 13401 Log: ANSI-TESTS:FULL-REPORT provides a clearer reports of test failures. Added test results between 0.25.0 and 0.26.0 on Solaris. Modified: trunk/abcl/test/lisp/ansi/ansi-test-failures trunk/abcl/test/lisp/ansi/parse-ansi-errors.lisp Modified: trunk/abcl/test/lisp/ansi/ansi-test-failures ============================================================================== --- trunk/abcl/test/lisp/ansi/ansi-test-failures Wed Jul 13 12:11:11 2011 (r13400) +++ trunk/abcl/test/lisp/ansi/ansi-test-failures Thu Jul 14 07:10:11 2011 (r13401) @@ -358,3 +358,62 @@ FORMAT.LOGICAL-BLOCK.CIRCLE.1 FORMAT.LOGICAL-BLOCK.CIRCLE.2 FORMAT.LOGICAL-BLOCK.CIRCLE.3 WITH-STANDARD-IO-SYNTAX.23 TRACE.8)) +(doit 0.25.0 :id saturn + :uname "i386-pc-solaris2.11.oi_148" :jvm "jdk-1.6.0_25" + (DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 DEFGENERIC.30 + CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 + MAKE-CONDITION.3 MAKE-CONDITION.4 DELETE-PACKAGE.5 + DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 MAKE-PATHNAME.9 + ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.2 + PRINT.RANDOM-STATE.1 PPRINT-FILL.14 PPRINT-FILL.15 + PPRINT-LINEAR.14 PPRINT-TABULAR.13 PPRINT-LOGICAL-BLOCK.17 + PPRINT-POP.7 PPRINT-POP.8 FORMAT.LOGICAL-BLOCK.CIRCLE.1 + FORMAT.LOGICAL-BLOCK.CIRCLE.2 FORMAT.LOGICAL-BLOCK.CIRCLE.3 + COMPILE-FILE.16)) + +(compileit 0.25.0 :id saturn + :uname "i386-pc-solaris2.11.oi_148" :jvm "jdk-1.6.0_25" + (MULTIPLE-VALUE-PROG1.10 DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 + DEFGENERIC.30 CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 + MAKE-CONDITION.3 MAKE-CONDITION.4 DELETE-PACKAGE.5 + DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 MAKE-PATHNAME.9 + ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.2 + PRINT.SYMBOL.RANDOM.4 PRINT.STRING.RANDOM.1 PRINT.RANDOM-STATE.1 + PPRINT-FILL.14 PPRINT-FILL.15 PPRINT-LINEAR.14 PPRINT-TABULAR.13 + PPRINT-LOGICAL-BLOCK.17 PPRINT-POP.7 PPRINT-POP.8 + FORMAT.LOGICAL-BLOCK.CIRCLE.1 FORMAT.LOGICAL-BLOCK.CIRCLE.2 + FORMAT.LOGICAL-BLOCK.CIRCLE.3 COMPILE-FILE.16 TRACE.8)) + +(doit 0.26.0 :id saturn + (DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 DEFGENERIC.30 + CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 + MAKE-CONDITION.3 MAKE-CONDITION.4 DELETE-PACKAGE.5 + DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 CHAR-NAME.1 + ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.2 + PRINT.RANDOM-STATE.1 PPRINT-FILL.14 PPRINT-FILL.15 + PPRINT-LINEAR.14 PPRINT-TABULAR.13 PPRINT-LOGICAL-BLOCK.17 + PPRINT-POP.7 PPRINT-POP.8 FORMAT.C.2A FORMATTER.C.2A + FORMAT.LOGICAL-BLOCK.CIRCLE.1 FORMAT.LOGICAL-BLOCK.CIRCLE.2 + FORMAT.LOGICAL-BLOCK.CIRCLE.3 SYNTAX.SHARP-BACKSLASH.6 + SYNTAX.SHARP-BACKSLASH.7)) + +(compileit 0.26.0 :id saturn + (MULTIPLE-VALUE-PROG1.10 DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 + DEFGENERIC.30 CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 + MAKE-CONDITION.3 MAKE-CONDITION.4 DELETE-PACKAGE.5 + DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 CHAR-NAME.1 + ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.4 + PRINT.RANDOM-STATE.1 PPRINT-FILL.14 PPRINT-FILL.15 + PPRINT-LINEAR.14 PPRINT-TABULAR.13 PPRINT-LOGICAL-BLOCK.17 + PPRINT-POP.7 PPRINT-POP.8 FORMAT.C.2A FORMATTER.C.2A + FORMAT.LOGICAL-BLOCK.CIRCLE.1 FORMAT.LOGICAL-BLOCK.CIRCLE.2 + FORMAT.LOGICAL-BLOCK.CIRCLE.3 SYNTAX.SHARP-BACKSLASH.6 + SYNTAX.SHARP-BACKSLASH.7 TRACE.8)) + + + + Modified: trunk/abcl/test/lisp/ansi/parse-ansi-errors.lisp ============================================================================== --- trunk/abcl/test/lisp/ansi/parse-ansi-errors.lisp Wed Jul 13 12:11:11 2011 (r13400) +++ trunk/abcl/test/lisp/ansi/parse-ansi-errors.lisp Thu Jul 14 07:10:11 2011 (r13401) @@ -71,7 +71,11 @@ (clrhash *id*)) (defun get-hash-table (test) - (getf `(doit ,*doit* compileit ,*compileit*) test)) + (let ((name (symbol-name test))) + (when (string-equal name "doit") + (return-from get-hash-table *doit*)) + (when (string-equal name "compileit") + (return-from get-hash-table *compileit*)))) (defvar *default-database-file* (if (find :asdf2 *features*) @@ -79,6 +83,9 @@ (merge-pathnames "ansi-test-failures" (directory-namestring *load-truename*)))) (defun parse (&optional (file *default-database-file*)) + "Parse the ansi test database present at *DEFAULT-DATABASE-FILE*. + +Optionally the file to parse may be specified by the FILE argument." (format t "Parsing test report database from ~A~%" *default-database-file*) (with-open-file (s file :direction :input) (do ((form (read s) (read s nil nil))) @@ -94,13 +101,13 @@ (push 'noid args) (push :id args)) (setf id (getf args :id)) + (unless (gethash version (get-hash-table test)) + (setf (gethash version (get-hash-table test)) + (make-hash-table))) (if (> (length args) 2) (setf (gethash id *id*) args) (if (null (gethash id *id*)) (setf (gethash id *id*) args))) - (when (null (gethash version (get-hash-table test))) - (setf (gethash version (get-hash-table test)) - (make-hash-table))) (setf (gethash id (gethash version (get-hash-table test))) failures)))))) @@ -139,6 +146,13 @@ failure-2))))))) (defun report (test version-1 version-2) + "Report on the difference of test failures for TEST between VERSION-1 and VERSION-2. + +TEST is symbol with a value of 'DOIT specifying the interpreted +version of the tests, or 'COMPILEIT specifiying the compiled verision of the tests. + +VERSION-1 and VERSION-2 are symbols of two versions contained in the test database." + (let ((reports (generate-report test version-1 version-2))) (dolist (report reports) (destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2) @@ -151,4 +165,32 @@ (format t "~A[~A] --> ~A[~A] additional failures:~%~A~%" version-2 id2 version-1 id1 diff-2->1)))))) +(defun full-report (version-1 version-2) + (let ((interpreted-reports (generate-report 'doit version-1 version-2)) + (compiled-reports (generate-report 'compileit version-1 version-2))) + (dolist (interpreted interpreted-reports) + (destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2) + (total-failures2 diff-2->1))) + interpreted + (format t "~2&Interpreted~%") + (format t "~&~20<~A-~A~>~20<~A-~A~>" id1 version-1 id2 version-2) + (format t "~&~20<~A failures~>~20<~A failures~>" + total-failures1 total-failures2) + (format t "~&~A-~A:~& ~A" id1 version-1 diff-1->2) + (format t "~&~A-~A:~& ~A" id2 version-2 diff-2->1))) + (dolist (compiled compiled-reports) + (destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2) + (total-failures2 diff-2->1))) + compiled + (format t "~2&Compiled~%") + (format t "~&~20<~A-~A~>~20<~A-~A~>" id1 version-1 id2 version-2) + (format t "~&~20<~A failures~>~20<~A failures~>" + total-failures1 total-failures2) + (format t "~&~A-~A:~& ~A" id1 version-1 diff-1->2) + (format t "~&~A-~A:~& ~A" id2 version-2 diff-2->1))))) + + + + + From mevenson at common-lisp.net Thu Jul 14 15:33:56 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 14 Jul 2011 08:33:56 -0700 Subject: [armedbear-cvs] r13402 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: mevenson Date: Thu Jul 14 08:33:56 2011 New Revision: 13402 Log: Fix failures of SYNTAX.SHARP-BACKSLASH.6 and SYNTAX.SHARP-BACKSLASH.7. The #\Unnnn syntax only accepts characters with exactly four digits, so we need to pad our names with leading zeros. Alternatively, we could loosen the four digit restricion. Modified: trunk/abcl/src/org/armedbear/lisp/LispCharacter.java Modified: trunk/abcl/src/org/armedbear/lisp/LispCharacter.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/LispCharacter.java Thu Jul 14 07:10:11 2011 (r13401) +++ trunk/abcl/src/org/armedbear/lisp/LispCharacter.java Thu Jul 14 08:33:56 2011 (r13402) @@ -627,7 +627,8 @@ } if (c > 255) { - return "U" + Integer.toString(c, 16); + final String result = "0000" + Integer.toString(c, 16); + return "U" + result.substring(result.length() - 4, result.length()); } if (c<0) return null; From mevenson at common-lisp.net Thu Jul 14 15:40:07 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 14 Jul 2011 08:40:07 -0700 Subject: [armedbear-cvs] r13403 - branches/0.26.x/abcl/src/org/armedbear/lisp Message-ID: Author: mevenson Date: Thu Jul 14 08:40:07 2011 New Revision: 13403 Log: Backport r13402: Fix failures of SYNTAX.SHARP-BACKSLASH.6 and SYNTAX.SHARP-BACKSLASH.7. Modified: branches/0.26.x/abcl/src/org/armedbear/lisp/LispCharacter.java Modified: branches/0.26.x/abcl/src/org/armedbear/lisp/LispCharacter.java ============================================================================== --- branches/0.26.x/abcl/src/org/armedbear/lisp/LispCharacter.java Thu Jul 14 08:33:56 2011 (r13402) +++ branches/0.26.x/abcl/src/org/armedbear/lisp/LispCharacter.java Thu Jul 14 08:40:07 2011 (r13403) @@ -627,7 +627,8 @@ } if (c > 255) { - return "U" + Integer.toString(c, 16); + final String result = "0000" + Integer.toString(c, 16); + return "U" + result.substring(result.length() - 4, result.length()); } if (c<0) return null; From mevenson at common-lisp.net Thu Jul 14 18:25:40 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 14 Jul 2011 11:25:40 -0700 Subject: [armedbear-cvs] r13404 - trunk/abcl/test/lisp/ansi Message-ID: Author: mevenson Date: Thu Jul 14 11:25:39 2011 New Revision: 13404 Log: Update test results after r13402. Export ANSI-TESTS:FULL-REPORT as it seems useful enough. Modified: trunk/abcl/test/lisp/ansi/ansi-test-failures trunk/abcl/test/lisp/ansi/package.lisp Modified: trunk/abcl/test/lisp/ansi/ansi-test-failures ============================================================================== --- trunk/abcl/test/lisp/ansi/ansi-test-failures Thu Jul 14 08:40:07 2011 (r13403) +++ trunk/abcl/test/lisp/ansi/ansi-test-failures Thu Jul 14 11:25:39 2011 (r13404) @@ -391,28 +391,27 @@ CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 MAKE-CONDITION.3 MAKE-CONDITION.4 DELETE-PACKAGE.5 - DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 CHAR-NAME.1 + DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.2 PRINT.RANDOM-STATE.1 PPRINT-FILL.14 PPRINT-FILL.15 PPRINT-LINEAR.14 PPRINT-TABULAR.13 PPRINT-LOGICAL-BLOCK.17 PPRINT-POP.7 PPRINT-POP.8 FORMAT.C.2A FORMATTER.C.2A FORMAT.LOGICAL-BLOCK.CIRCLE.1 FORMAT.LOGICAL-BLOCK.CIRCLE.2 - FORMAT.LOGICAL-BLOCK.CIRCLE.3 SYNTAX.SHARP-BACKSLASH.6 - SYNTAX.SHARP-BACKSLASH.7)) + FORMAT.LOGICAL-BLOCK.CIRCLE.3)) (compileit 0.26.0 :id saturn (MULTIPLE-VALUE-PROG1.10 DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 DEFGENERIC.30 CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 MAKE-CONDITION.3 MAKE-CONDITION.4 DELETE-PACKAGE.5 - DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 CHAR-NAME.1 - ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.4 - PRINT.RANDOM-STATE.1 PPRINT-FILL.14 PPRINT-FILL.15 - PPRINT-LINEAR.14 PPRINT-TABULAR.13 PPRINT-LOGICAL-BLOCK.17 - PPRINT-POP.7 PPRINT-POP.8 FORMAT.C.2A FORMATTER.C.2A - FORMAT.LOGICAL-BLOCK.CIRCLE.1 FORMAT.LOGICAL-BLOCK.CIRCLE.2 - FORMAT.LOGICAL-BLOCK.CIRCLE.3 SYNTAX.SHARP-BACKSLASH.6 - SYNTAX.SHARP-BACKSLASH.7 TRACE.8)) + DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 + ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.2 + PRINT.SYMBOL.RANDOM.4 PRINT.RANDOM-STATE.1 PPRINT-FILL.14 + PPRINT-FILL.15 PPRINT-LINEAR.14 PPRINT-TABULAR.13 + PPRINT-LOGICAL-BLOCK.17 PPRINT-POP.7 PPRINT-POP.8 FORMAT.C.2A + FORMATTER.C.2A FORMAT.LOGICAL-BLOCK.CIRCLE.1 + FORMAT.LOGICAL-BLOCK.CIRCLE.2 FORMAT.LOGICAL-BLOCK.CIRCLE.3 + TRACE.8)) Modified: trunk/abcl/test/lisp/ansi/package.lisp ============================================================================== --- trunk/abcl/test/lisp/ansi/package.lisp Thu Jul 14 08:40:07 2011 (r13403) +++ trunk/abcl/test/lisp/ansi/package.lisp Thu Jul 14 11:25:39 2011 (r13404) @@ -5,6 +5,7 @@ #:verify-ansi-tests #:load-tests #:clean-tests + #:full-report #:report #:parse)) (in-package :abcl.test.ansi) From ehuelsmann at common-lisp.net Thu Jul 14 19:23:12 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Thu, 14 Jul 2011 12:23:12 -0700 Subject: [armedbear-cvs] r13405 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Thu Jul 14 12:23:11 2011 New Revision: 13405 Log: Set svn:keywords and svn:eol-style properties. Modified: trunk/abcl/src/org/armedbear/lisp/JarStream.java (contents, props changed) trunk/abcl/src/org/armedbear/lisp/URLStream.java (contents, props changed) trunk/abcl/src/org/armedbear/lisp/WeakHashTable.java (props changed) trunk/abcl/src/org/armedbear/lisp/WeakReference.java (contents, props changed) Modified: trunk/abcl/src/org/armedbear/lisp/JarStream.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/JarStream.java Thu Jul 14 11:25:39 2011 (r13404) +++ trunk/abcl/src/org/armedbear/lisp/JarStream.java Thu Jul 14 12:23:11 2011 (r13405) @@ -2,7 +2,7 @@ * JarStream.java * * Copyright (C) 2010 Mark Evenson - * $Id: FileStream.java 12422 2010-02-06 10:52:32Z mevenson $ + * $Id$ * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License Modified: trunk/abcl/src/org/armedbear/lisp/URLStream.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/URLStream.java Thu Jul 14 11:25:39 2011 (r13404) +++ trunk/abcl/src/org/armedbear/lisp/URLStream.java Thu Jul 14 12:23:11 2011 (r13405) @@ -2,7 +2,7 @@ * URLStream.java * * Copyright (C) 2010 Mark Evenson - * $Id: FileStream.java 12422 2010-02-06 10:52:32Z mevenson $ + * $Id$ * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License Modified: trunk/abcl/src/org/armedbear/lisp/WeakReference.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/WeakReference.java Thu Jul 14 11:25:39 2011 (r13404) +++ trunk/abcl/src/org/armedbear/lisp/WeakReference.java Thu Jul 14 12:23:11 2011 (r13405) @@ -1,112 +1,112 @@ -/* - * WeakReference.java - * - * Copyright (C) 2011 Erik Huelsmann - * $Id: JavaStackFrame.java 12288 2009-11-29 22:00:12Z vvoutilainen $ - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - * - * As a special exception, the copyright holders of this library give you - * permission to link this library with independent modules to produce an - * executable, regardless of the license terms of these independent - * modules, and to copy and distribute the resulting executable under - * terms of your choice, provided that you also meet, for each linked - * independent module, the terms and conditions of the license of that - * module. An independent module is a module which is not derived from - * or based on this library. If you modify this library, you may extend - * this exception to your version of the library, but you are not - * obligated to do so. If you do not wish to do so, delete this - * exception statement from your version. - */ -package org.armedbear.lisp; - -import static org.armedbear.lisp.Lisp.*; - -public class WeakReference extends LispObject { - - java.lang.ref.WeakReference ref; - - public WeakReference(LispObject ref) { - this.ref = new java.lang.ref.WeakReference(ref); - } - - @Override - public LispObject typeOf() { - return Symbol.WEAK_REFERENCE; - } - - @Override - public LispObject classOf() { - return BuiltInClass.WEAK_REFERENCE; - } - - @Override - public String writeToString() { - return unreadableString("WEAK-REFERENCE " - + toString()); - } - - @Override - public LispObject typep(LispObject typeSpecifier) { - if (typeSpecifier == Symbol.WEAK_REFERENCE) { - return T; - } - if (typeSpecifier == BuiltInClass.WEAK_REFERENCE) { - return T; - } - return super.typep(typeSpecifier); - } - - private static final Primitive MAKE_WEAK_REFERENCE = - new pf_make_weak_reference(); - @DocString(name="make-weak-reference", args="obj", - doc="Creates a weak reference to 'obj'.") - private static final class pf_make_weak_reference extends Primitive - { - pf_make_weak_reference() - { - super("make-weak-reference", PACKAGE_EXT, true); - } - - @Override - public LispObject execute(LispObject obj) { - return new WeakReference(obj); - } - }; - - private static final Primitive WEAK_REFERENCE_VALUE = - new pf_weak_reference_value(); - @DocString(name="weak-reference-value", args="obj", - doc="Returns two values, the first being the value of the weak ref," - + "the second T if the reference is valid, or NIL if it has" - + "been cleared.") - private static final class pf_weak_reference_value extends Primitive - { - pf_weak_reference_value() - { - super("weak-reference-value", PACKAGE_EXT, true); - } - - @Override - public LispObject execute(LispObject obj) { - if (! (obj instanceof WeakReference)) - return Lisp.type_error(obj, Symbol.WEAK_REFERENCE); - - LispObject value = ((WeakReference)obj).ref.get(); - return LispThread.currentThread().setValues(value == null ? NIL : value, - value == null ? NIL : T); - } - }; -} +/* + * WeakReference.java + * + * Copyright (C) 2011 Erik Huelsmann + * $Id$ + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + * + * As a special exception, the copyright holders of this library give you + * permission to link this library with independent modules to produce an + * executable, regardless of the license terms of these independent + * modules, and to copy and distribute the resulting executable under + * terms of your choice, provided that you also meet, for each linked + * independent module, the terms and conditions of the license of that + * module. An independent module is a module which is not derived from + * or based on this library. If you modify this library, you may extend + * this exception to your version of the library, but you are not + * obligated to do so. If you do not wish to do so, delete this + * exception statement from your version. + */ +package org.armedbear.lisp; + +import static org.armedbear.lisp.Lisp.*; + +public class WeakReference extends LispObject { + + java.lang.ref.WeakReference ref; + + public WeakReference(LispObject ref) { + this.ref = new java.lang.ref.WeakReference(ref); + } + + @Override + public LispObject typeOf() { + return Symbol.WEAK_REFERENCE; + } + + @Override + public LispObject classOf() { + return BuiltInClass.WEAK_REFERENCE; + } + + @Override + public String writeToString() { + return unreadableString("WEAK-REFERENCE " + + toString()); + } + + @Override + public LispObject typep(LispObject typeSpecifier) { + if (typeSpecifier == Symbol.WEAK_REFERENCE) { + return T; + } + if (typeSpecifier == BuiltInClass.WEAK_REFERENCE) { + return T; + } + return super.typep(typeSpecifier); + } + + private static final Primitive MAKE_WEAK_REFERENCE = + new pf_make_weak_reference(); + @DocString(name="make-weak-reference", args="obj", + doc="Creates a weak reference to 'obj'.") + private static final class pf_make_weak_reference extends Primitive + { + pf_make_weak_reference() + { + super("make-weak-reference", PACKAGE_EXT, true); + } + + @Override + public LispObject execute(LispObject obj) { + return new WeakReference(obj); + } + }; + + private static final Primitive WEAK_REFERENCE_VALUE = + new pf_weak_reference_value(); + @DocString(name="weak-reference-value", args="obj", + doc="Returns two values, the first being the value of the weak ref," + + "the second T if the reference is valid, or NIL if it has" + + "been cleared.") + private static final class pf_weak_reference_value extends Primitive + { + pf_weak_reference_value() + { + super("weak-reference-value", PACKAGE_EXT, true); + } + + @Override + public LispObject execute(LispObject obj) { + if (! (obj instanceof WeakReference)) + return Lisp.type_error(obj, Symbol.WEAK_REFERENCE); + + LispObject value = ((WeakReference)obj).ref.get(); + return LispThread.currentThread().setValues(value == null ? NIL : value, + value == null ? NIL : T); + } + }; +} From ehuelsmann at common-lisp.net Fri Jul 15 16:34:24 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Fri, 15 Jul 2011 09:34:24 -0700 Subject: [armedbear-cvs] r13406 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Fri Jul 15 09:34:23 2011 New Revision: 13406 Log: Avoid using a temporary file when copying a random state; it's complete overkill in the presence of memory (byte array) backed streams. Modified: trunk/abcl/src/org/armedbear/lisp/RandomState.java Modified: trunk/abcl/src/org/armedbear/lisp/RandomState.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/RandomState.java Thu Jul 14 12:23:11 2011 (r13405) +++ trunk/abcl/src/org/armedbear/lisp/RandomState.java Fri Jul 15 09:34:23 2011 (r13406) @@ -35,9 +35,8 @@ import static org.armedbear.lisp.Lisp.*; -import java.io.File; -import java.io.FileInputStream; -import java.io.FileOutputStream; +import java.io.ByteArrayInputStream; +import java.io.ByteArrayOutputStream; import java.io.ObjectInputStream; import java.io.ObjectOutputStream; import java.math.BigInteger; @@ -55,16 +54,14 @@ public RandomState(RandomState rs) { try { - File file = File.createTempFile("MAKE-RANDOM-STATE", null); - FileOutputStream fileOut = new FileOutputStream(file); - ObjectOutputStream out = new ObjectOutputStream(fileOut); + ByteArrayOutputStream byteOut = new ByteArrayOutputStream(); + ObjectOutputStream out = new ObjectOutputStream(byteOut); out.writeObject(rs.random); out.close(); - FileInputStream fileIn = new FileInputStream(file); - ObjectInputStream in = new ObjectInputStream(fileIn); + ByteArrayInputStream byteIn = new ByteArrayInputStream(byteOut.toByteArray()); + ObjectInputStream in = new ObjectInputStream(byteIn); random = (Random) in.readObject(); in.close(); - file.delete(); // FIXME: file leak on exception } catch (Throwable t) { // ANY exception gets converted to a lisp error error(new LispError("Unable to copy random state.")); From ehuelsmann at common-lisp.net Fri Jul 15 21:18:29 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Fri, 15 Jul 2011 14:18:29 -0700 Subject: [armedbear-cvs] r13407 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Fri Jul 15 14:18:28 2011 New Revision: 13407 Log: Eliminate a series of PPRINT.* ansi test suite failures (dropping my test failure count from 27 to 20!). Modified: trunk/abcl/src/org/armedbear/lisp/pprint.lisp Modified: trunk/abcl/src/org/armedbear/lisp/pprint.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/pprint.lisp Fri Jul 15 09:34:23 2011 (r13406) +++ trunk/abcl/src/org/armedbear/lisp/pprint.lisp Fri Jul 15 14:18:28 2011 (r13407) @@ -611,12 +611,14 @@ (if (xp-structure-p stream) (apply fn stream args) (let ((*abbreviation-happened* nil) - (sys::*circularity-hash-table* - (if (and *print-circle* (null sys::*circularity-hash-table*)) - (make-hash-table :test 'eq) - sys::*circularity-hash-table*)) (*result* nil)) - (xp-print fn (sys:out-synonym-of stream) args) + (if (and *print-circle* (null sys::*circularity-hash-table*)) + (let ((sys::*circularity-hash-table* (make-hash-table :test 'eq))) + (xp-print fn (make-broadcast-stream) args) + (let ((sys::*circularity-counter* 0)) + (xp-print fn (sys:out-synonym-of stream) args) + )) + (xp-print fn (sys:out-synonym-of stream) args)) *result*))) (defun xp-print (fn stream args) From ehuelsmann at common-lisp.net Sat Jul 16 22:49:03 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sat, 16 Jul 2011 15:49:03 -0700 Subject: [armedbear-cvs] r13408 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sat Jul 16 15:49:01 2011 New Revision: 13408 Log: Fix 2 more pretty printer (PPRINT-*) test cases. Modified: trunk/abcl/src/org/armedbear/lisp/pprint.lisp Modified: trunk/abcl/src/org/armedbear/lisp/pprint.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/pprint.lisp Fri Jul 15 14:18:28 2011 (r13407) +++ trunk/abcl/src/org/armedbear/lisp/pprint.lisp Sat Jul 16 15:49:01 2011 (r13408) @@ -607,17 +607,22 @@ (sys:output-object object (sys:out-synonym-of stream)) object) -(defun maybe-initiate-xp-printing (fn stream &rest args) +(defun maybe-initiate-xp-printing (object fn stream &rest args) (if (xp-structure-p stream) (apply fn stream args) (let ((*abbreviation-happened* nil) (*result* nil)) (if (and *print-circle* (null sys::*circularity-hash-table*)) (let ((sys::*circularity-hash-table* (make-hash-table :test 'eq))) + (setf (gethash object sys::*circularity-hash-table*) t) (xp-print fn (make-broadcast-stream) args) (let ((sys::*circularity-counter* 0)) - (xp-print fn (sys:out-synonym-of stream) args) - )) + (when (eql 0 (gethash object sys::*circularity-hash-table*)) + (setf (gethash object sys::*circularity-hash-table*) + (incf sys::*circularity-counter*)) + (sys::print-label (gethash object sys::*circularity-hash-table*) + (sys:out-synonym-of stream))) + (xp-print fn (sys:out-synonym-of stream) args))) (xp-print fn (sys:out-synonym-of stream) args)) *result*))) @@ -864,17 +869,19 @@ (setf stream-symbol '*standard-output*)) (when (and prefix-p per-line-prefix-p) (error "Cannot specify values for both PREFIX and PER-LINE-PREFIX.")) - `(maybe-initiate-xp-printing - #'(lambda (,stream-symbol) - (let ((+l ,object) - (+p ,(cond (prefix-p prefix) - (per-line-prefix-p per-line-prefix) - (t ""))) - (+s ,suffix)) - (pprint-logical-block+ + `(let ((+l ,object)) + (maybe-initiate-xp-printing + +l + #'(lambda (,stream-symbol) + (let ((+l +l) + (+p ,(cond (prefix-p prefix) + (per-line-prefix-p per-line-prefix) + (t ""))) + (+s ,suffix)) + (pprint-logical-block+ (,stream-symbol +l +p +s ,per-line-prefix-p t nil) ,@ body nil))) - (sys:out-synonym-of ,stream-symbol))) + (sys:out-synonym-of ,stream-symbol)))) ;Assumes var and args must be variables. Other arguments must be literals or variables. @@ -1347,14 +1354,14 @@ ;; stream object)) ;; (t ;; (assert nil) -;; (sys:output-object object stream)))) +;; (syss:output-object object stream)))) (defun output-pretty-object (object stream) ;; (basic-write object stream)) (cond ((xp-structure-p stream) (write+ object stream)) (*print-pretty* - (maybe-initiate-xp-printing #'(lambda (s o) (write+ o s)) + (maybe-initiate-xp-printing object #'(lambda (s o) (write+ o s)) stream object)) (t (assert nil) From ehuelsmann at common-lisp.net Sun Jul 17 10:50:25 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sun, 17 Jul 2011 03:50:25 -0700 Subject: [armedbear-cvs] r13409 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sun Jul 17 03:50:20 2011 New Revision: 13409 Log: Re #160: note the root cause. Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Primitives.java Sat Jul 16 15:49:01 2011 (r13408) +++ trunk/abcl/src/org/armedbear/lisp/Primitives.java Sun Jul 17 03:50:20 2011 (r13409) @@ -910,6 +910,10 @@ String output = first.writeToString(); if (Symbol.PRINT_READABLY.symbolValue(LispThread.currentThread()) != NIL && output.contains("#<")) { + //### Ticket #160: the cause lies here. + // You can't just go scan the content of the printed string, + // because the marker being sought may be part of the readable + // presentation LispObject args = NIL; args = args.push(first); args = args.push(Keyword.OBJECT); From ehuelsmann at common-lisp.net Sun Jul 17 15:53:11 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sun, 17 Jul 2011 08:53:11 -0700 Subject: [armedbear-cvs] r13410 - branches/0.26.x/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sun Jul 17 08:53:11 2011 New Revision: 13410 Log: Backport r13407 and r13408: fixes for pretty printer output with circular or shared structure. Modified: branches/0.26.x/abcl/src/org/armedbear/lisp/pprint.lisp Modified: branches/0.26.x/abcl/src/org/armedbear/lisp/pprint.lisp ============================================================================== --- branches/0.26.x/abcl/src/org/armedbear/lisp/pprint.lisp Sun Jul 17 03:50:20 2011 (r13409) +++ branches/0.26.x/abcl/src/org/armedbear/lisp/pprint.lisp Sun Jul 17 08:53:11 2011 (r13410) @@ -607,16 +607,23 @@ (sys:output-object object (sys:out-synonym-of stream)) object) -(defun maybe-initiate-xp-printing (fn stream &rest args) +(defun maybe-initiate-xp-printing (object fn stream &rest args) (if (xp-structure-p stream) (apply fn stream args) (let ((*abbreviation-happened* nil) - (sys::*circularity-hash-table* - (if (and *print-circle* (null sys::*circularity-hash-table*)) - (make-hash-table :test 'eq) - sys::*circularity-hash-table*)) (*result* nil)) - (xp-print fn (sys:out-synonym-of stream) args) + (if (and *print-circle* (null sys::*circularity-hash-table*)) + (let ((sys::*circularity-hash-table* (make-hash-table :test 'eq))) + (setf (gethash object sys::*circularity-hash-table*) t) + (xp-print fn (make-broadcast-stream) args) + (let ((sys::*circularity-counter* 0)) + (when (eql 0 (gethash object sys::*circularity-hash-table*)) + (setf (gethash object sys::*circularity-hash-table*) + (incf sys::*circularity-counter*)) + (sys::print-label (gethash object sys::*circularity-hash-table*) + (sys:out-synonym-of stream))) + (xp-print fn (sys:out-synonym-of stream) args))) + (xp-print fn (sys:out-synonym-of stream) args)) *result*))) (defun xp-print (fn stream args) @@ -862,17 +869,19 @@ (setf stream-symbol '*standard-output*)) (when (and prefix-p per-line-prefix-p) (error "Cannot specify values for both PREFIX and PER-LINE-PREFIX.")) - `(maybe-initiate-xp-printing - #'(lambda (,stream-symbol) - (let ((+l ,object) - (+p ,(cond (prefix-p prefix) - (per-line-prefix-p per-line-prefix) - (t ""))) - (+s ,suffix)) - (pprint-logical-block+ + `(let ((+l ,object)) + (maybe-initiate-xp-printing + +l + #'(lambda (,stream-symbol) + (let ((+l +l) + (+p ,(cond (prefix-p prefix) + (per-line-prefix-p per-line-prefix) + (t ""))) + (+s ,suffix)) + (pprint-logical-block+ (,stream-symbol +l +p +s ,per-line-prefix-p t nil) ,@ body nil))) - (sys:out-synonym-of ,stream-symbol))) + (sys:out-synonym-of ,stream-symbol)))) ;Assumes var and args must be variables. Other arguments must be literals or variables. @@ -1345,14 +1354,14 @@ ;; stream object)) ;; (t ;; (assert nil) -;; (sys:output-object object stream)))) +;; (syss:output-object object stream)))) (defun output-pretty-object (object stream) ;; (basic-write object stream)) (cond ((xp-structure-p stream) (write+ object stream)) (*print-pretty* - (maybe-initiate-xp-printing #'(lambda (s o) (write+ o s)) + (maybe-initiate-xp-printing object #'(lambda (s o) (write+ o s)) stream object)) (t (assert nil) From ehuelsmann at common-lisp.net Sun Jul 17 15:53:25 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Sun, 17 Jul 2011 08:53:25 -0700 Subject: [armedbear-cvs] r13411 - branches/0.26.x/abcl Message-ID: Author: ehuelsmann Date: Sun Jul 17 08:53:25 2011 New Revision: 13411 Log: Update CHANGES. Modified: branches/0.26.x/abcl/CHANGES Modified: branches/0.26.x/abcl/CHANGES ============================================================================== --- branches/0.26.x/abcl/CHANGES Sun Jul 17 08:53:11 2011 (r13410) +++ branches/0.26.x/abcl/CHANGES Sun Jul 17 08:53:25 2011 (r13411) @@ -5,8 +5,15 @@ Fixes ----- - * Fix compilation problems by including the - org.armedbear.lisp.protocol source in the build process. + * Fix compilation problems by including the + org.armedbear.lisp.protocol source in the build process + + * Printing of conditions defined with DEFINE-CONDITION + + * Regression with failing SYNTAX.SHARP-BACKSLASH.6 + and SYNTAX.SHARP-BACKSLASH.7 ANSI test suite failures + + * Multiple failures in PPRINT.* ANSI test suite failures Version 0.26.0 ============== From ehuelsmann at common-lisp.net Thu Jul 21 18:59:59 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Thu, 21 Jul 2011 11:59:59 -0700 Subject: [armedbear-cvs] r13412 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Thu Jul 21 11:59:58 2011 New Revision: 13412 Log: Fix Java interop issue. Found by: Theam Yong Chew (senatorzergling at gmail dot com) Modified: trunk/abcl/src/org/armedbear/lisp/ComplexString.java Modified: trunk/abcl/src/org/armedbear/lisp/ComplexString.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/ComplexString.java Sun Jul 17 08:53:25 2011 (r13411) +++ trunk/abcl/src/org/armedbear/lisp/ComplexString.java Thu Jul 21 11:59:58 2011 (r13412) @@ -330,7 +330,7 @@ @Override public Object javaInstance() { - return new String(chars()); + return new String(getStringValue()); } @Override From ehuelsmann at common-lisp.net Thu Jul 21 21:35:28 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Thu, 21 Jul 2011 14:35:28 -0700 Subject: [armedbear-cvs] r13413 - in branches/0.26.x/abcl: . src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Thu Jul 21 14:35:27 2011 New Revision: 13413 Log: Backport r13412 and update CHANGES. Modified: branches/0.26.x/abcl/CHANGES branches/0.26.x/abcl/src/org/armedbear/lisp/ComplexString.java Modified: branches/0.26.x/abcl/CHANGES ============================================================================== --- branches/0.26.x/abcl/CHANGES Thu Jul 21 11:59:58 2011 (r13412) +++ branches/0.26.x/abcl/CHANGES Thu Jul 21 14:35:27 2011 (r13413) @@ -15,6 +15,8 @@ * Multiple failures in PPRINT.* ANSI test suite failures + * String interop with Java for strings with fill pointer + Version 0.26.0 ============== svn://common-lisp.net/project/armedbear/svn/tags/0.26.0/abcl Modified: branches/0.26.x/abcl/src/org/armedbear/lisp/ComplexString.java ============================================================================== --- branches/0.26.x/abcl/src/org/armedbear/lisp/ComplexString.java Thu Jul 21 11:59:58 2011 (r13412) +++ branches/0.26.x/abcl/src/org/armedbear/lisp/ComplexString.java Thu Jul 21 14:35:27 2011 (r13413) @@ -330,7 +330,7 @@ @Override public Object javaInstance() { - return new String(chars()); + return new String(getStringValue()); } @Override From mevenson at common-lisp.net Fri Jul 22 06:20:13 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 21 Jul 2011 23:20:13 -0700 Subject: [armedbear-cvs] r13414 - trunk/abcl/test/lisp/ansi Message-ID: Author: mevenson Date: Thu Jul 21 23:20:11 2011 New Revision: 13414 Log: Update with ANSI test results for 0.26.1. Modified: trunk/abcl/test/lisp/ansi/ansi-test-failures Modified: trunk/abcl/test/lisp/ansi/ansi-test-failures ============================================================================== --- trunk/abcl/test/lisp/ansi/ansi-test-failures Thu Jul 21 14:35:27 2011 (r13413) +++ trunk/abcl/test/lisp/ansi/ansi-test-failures Thu Jul 21 23:20:11 2011 (r13414) @@ -386,32 +386,23 @@ FORMAT.LOGICAL-BLOCK.CIRCLE.1 FORMAT.LOGICAL-BLOCK.CIRCLE.2 FORMAT.LOGICAL-BLOCK.CIRCLE.3 COMPILE-FILE.16 TRACE.8)) -(doit 0.26.0 :id saturn - (DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 DEFGENERIC.30 - CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 - DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 - MAKE-CONDITION.3 MAKE-CONDITION.4 DELETE-PACKAGE.5 - DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 - ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.2 - PRINT.RANDOM-STATE.1 PPRINT-FILL.14 PPRINT-FILL.15 - PPRINT-LINEAR.14 PPRINT-TABULAR.13 PPRINT-LOGICAL-BLOCK.17 - PPRINT-POP.7 PPRINT-POP.8 FORMAT.C.2A FORMATTER.C.2A - FORMAT.LOGICAL-BLOCK.CIRCLE.1 FORMAT.LOGICAL-BLOCK.CIRCLE.2 - FORMAT.LOGICAL-BLOCK.CIRCLE.3)) +(doit 0.26.1 :id saturn + (DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 DEFGENERIC.30 + CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 MAKE-CONDITION.3 + MAKE-CONDITION.4 DELETE-PACKAGE.5 DELETE-PACKAGE.6 MAP.48 + TYPE-OF.1 TYPE-OF.4 ENSURE-DIRECTORIES-EXIST.8 + PRINT.SYMBOL.RANDOM.2 PRINT.RANDOM-STATE.1 + PPRINT-LOGICAL-BLOCK.17 FORMAT.C.2A FORMATTER.C.2A)) -(compileit 0.26.0 :id saturn - (MULTIPLE-VALUE-PROG1.10 DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 - DEFGENERIC.30 CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 - DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 - MAKE-CONDITION.3 MAKE-CONDITION.4 DELETE-PACKAGE.5 - DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 - ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.2 - PRINT.SYMBOL.RANDOM.4 PRINT.RANDOM-STATE.1 PPRINT-FILL.14 - PPRINT-FILL.15 PPRINT-LINEAR.14 PPRINT-TABULAR.13 - PPRINT-LOGICAL-BLOCK.17 PPRINT-POP.7 PPRINT-POP.8 FORMAT.C.2A - FORMATTER.C.2A FORMAT.LOGICAL-BLOCK.CIRCLE.1 - FORMAT.LOGICAL-BLOCK.CIRCLE.2 FORMAT.LOGICAL-BLOCK.CIRCLE.3 - TRACE.8)) +(compileit 0.26.1 :id saturn + (MULTIPLE-VALUE-PROG1.10 DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 + DEFGENERIC.30 CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 MAKE-CONDITION.3 + MAKE-CONDITION.4 DELETE-PACKAGE.5 DELETE-PACKAGE.6 MAP.48 + TYPE-OF.1 TYPE-OF.4 ENSURE-DIRECTORIES-EXIST.8 + PRINT.RANDOM-STATE.1 PPRINT-LOGICAL-BLOCK.17 FORMAT.C.2A + FORMATTER.C.2A TRACE.8)) From mevenson at common-lisp.net Tue Jul 26 18:50:05 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 26 Jul 2011 11:50:05 -0700 Subject: [armedbear-cvs] r13415 - in trunk/abcl: doc/manual src/org/armedbear/lisp test/lisp/ansi Message-ID: Author: mevenson Date: Tue Jul 26 11:50:04 2011 New Revision: 13415 Log: Don't print the #\Uxxxx representation for character codes greater than 0xff. We make #\Uxxxx a synonym of character code but not the cannonical character name, using instead the unicode character at that point. Modified: trunk/abcl/doc/manual/abcl.tex trunk/abcl/src/org/armedbear/lisp/LispCharacter.java trunk/abcl/test/lisp/ansi/ansi-test-failures Modified: trunk/abcl/doc/manual/abcl.tex ============================================================================== --- trunk/abcl/doc/manual/abcl.tex Thu Jul 21 23:20:11 2011 (r13414) +++ trunk/abcl/doc/manual/abcl.tex Tue Jul 26 11:50:04 2011 (r13415) @@ -22,10 +22,14 @@ \subsection{Requirements} -java-1.5.xx, java-1.6.0_10+ recommended. +java-1.5.xx, java-1.6.0__10+ recommended. +% Omit the build instructions? This really doesn't belong in a User +% Manual, or if it does, then in an appendix. --ME 20110725 \subsection{Building from Source} + + There are three ways to build ABCL from the source release with the preferred (and most tested way) is to being to use the Ant build tool: @@ -238,7 +242,6 @@ \end{code} - The Lisp \code{eval} primitive may be simply passed strings for evaluation, as follows @@ -249,12 +252,12 @@ Notice that all possible return values from an arbitrary Lisp computation are collapsed into a single return value. Doing useful -further computation on the `LispObject` depends on knowing what the +further computation on the ``LispObject'' depends on knowing what the result of the computation might be, usually involves some amount of \code{instanceof} introspection, and forms a whole topic to itself (c.f. [Introspecting a LispObject](#introspecting)). -Using `EVAL` involves the Lisp interpreter. Lisp functions may be +Using ``EVAL'' involves the Lisp interpreter. Lisp functions may be directly invoked by Java method calls as follows. One simply locates the package containing the symbol, then obtains a reference to the symbol, and then invokes the `execute()` method with the desired @@ -268,7 +271,7 @@ JavaObject parameter = new JavaObject("Lisp is fun!"); LispObject result = fooFunction.execute(parameter); // How to get the "naked string value"? - System.out.prinln("The result was " + result.writeToString()); + System.out.println("The result was " + result.writeToString()); \end{code} If one is calling an primitive function in the CL package the syntax @@ -401,6 +404,18 @@ ? \end[java]{code} +\subsubsection{Extensions to the Reader} + +We implement a special hexadecimal escape sequence for specifying +characters to the Lisp reader, namely we allow a sequences of the form +#\Uxxxx to be processed by the reader as character whose code is +specified by the hexadecimal digits `xxxx'. The hexadecimal sequence +must be exactly four digits long, padded by leading zeros for values +less than 0x1000. + +Note that this sequence is never output by the implementation. Instead, +the corresponding Unicode character is output for characters whose +code is greater than 0x00ff. \section{Multithreading} @@ -409,6 +424,17 @@ \section{History} +ABCL was originally the extension language for the J editor, which was +started in 1998 by Peter Graves. Sometime in 2003, it seems that a +lot of code that had previously not been released publically was +suddenly committed that enabled ABCL to be plausibly termed an ANSI +Common Lisp implementation. + +In 2006, the implementation was transferred to the current +maintainers, who have strived to improve its usability as a +contemporary Common Lisp implementation. + + \end{document} % TODO Modified: trunk/abcl/src/org/armedbear/lisp/LispCharacter.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/LispCharacter.java Thu Jul 21 23:20:11 2011 (r13414) +++ trunk/abcl/src/org/armedbear/lisp/LispCharacter.java Tue Jul 26 11:50:04 2011 (r13415) @@ -626,12 +626,7 @@ return "Rubout"; } - if (c > 255) { - final String result = "0000" + Integer.toString(c, 16); - return "U" + result.substring(result.length() - 4, result.length()); - } - - if (c<0) return null; + if (c<0 || c>255) return null; return lispChars.get(c).name; } Modified: trunk/abcl/test/lisp/ansi/ansi-test-failures ============================================================================== --- trunk/abcl/test/lisp/ansi/ansi-test-failures Thu Jul 21 23:20:11 2011 (r13414) +++ trunk/abcl/test/lisp/ansi/ansi-test-failures Tue Jul 26 11:50:04 2011 (r13415) @@ -404,6 +404,27 @@ PRINT.RANDOM-STATE.1 PPRINT-LOGICAL-BLOCK.17 FORMAT.C.2A FORMATTER.C.2A TRACE.8)) +(doit 0.27.0-dev-13414M :id saturn + (DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 DEFGENERIC.30 + CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 DEFMETHOD.ERROR.14 + DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 MAKE-CONDITION.3 MAKE-CONDITION.4 + DELETE-PACKAGE.5 DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 + ENSURE-DIRECTORIES-EXIST.8 PRINT.RANDOM-STATE.1 + PPRINT-LOGICAL-BLOCK.17)) + +(compileit 0.27.0-dev-13414M :id saturn + (ETYPECASE.15 MULTIPLE-VALUE-PROG1.10 DEFGENERIC.ERROR.20 + DEFGENERIC.ERROR.21 DEFGENERIC.30 CALL-NEXT-METHOD.ERROR.1 + CALL-NEXT-METHOD.ERROR.2 DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 + INVOKE-DEBUGGER.1 MAKE-CONDITION.3 MAKE-CONDITION.4 + DELETE-PACKAGE.5 DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 + ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.2 + PRINT.SYMBOL.RANDOM.3 PRINT.SYMBOL.RANDOM.4 + PRINT.RANDOM-STATE.1 PPRINT-LOGICAL-BLOCK.17 TRACE.8)) + + + + From mevenson at common-lisp.net Tue Jul 26 19:55:05 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 26 Jul 2011 12:55:05 -0700 Subject: [armedbear-cvs] r13416 - in branches/0.26.x/abcl: doc/manual src/org/armedbear/lisp test/lisp/ansi Message-ID: Author: mevenson Date: Tue Jul 26 12:55:04 2011 New Revision: 13416 Log: Backport r13415: make #\Uxxxx a synonym for a character not the cannoical name. Modified: branches/0.26.x/abcl/doc/manual/abcl.tex branches/0.26.x/abcl/src/org/armedbear/lisp/LispCharacter.java branches/0.26.x/abcl/test/lisp/ansi/ansi-test-failures Modified: branches/0.26.x/abcl/doc/manual/abcl.tex ============================================================================== --- branches/0.26.x/abcl/doc/manual/abcl.tex Tue Jul 26 11:50:04 2011 (r13415) +++ branches/0.26.x/abcl/doc/manual/abcl.tex Tue Jul 26 12:55:04 2011 (r13416) @@ -22,10 +22,14 @@ \subsection{Requirements} -java-1.5.xx, java-1.6.0_10+ recommended. +java-1.5.xx, java-1.6.0__10+ recommended. +% Omit the build instructions? This really doesn't belong in a User +% Manual, or if it does, then in an appendix. --ME 20110725 \subsection{Building from Source} + + There are three ways to build ABCL from the source release with the preferred (and most tested way) is to being to use the Ant build tool: @@ -238,7 +242,6 @@ \end{code} - The Lisp \code{eval} primitive may be simply passed strings for evaluation, as follows @@ -249,12 +252,12 @@ Notice that all possible return values from an arbitrary Lisp computation are collapsed into a single return value. Doing useful -further computation on the `LispObject` depends on knowing what the +further computation on the ``LispObject'' depends on knowing what the result of the computation might be, usually involves some amount of \code{instanceof} introspection, and forms a whole topic to itself (c.f. [Introspecting a LispObject](#introspecting)). -Using `EVAL` involves the Lisp interpreter. Lisp functions may be +Using ``EVAL'' involves the Lisp interpreter. Lisp functions may be directly invoked by Java method calls as follows. One simply locates the package containing the symbol, then obtains a reference to the symbol, and then invokes the `execute()` method with the desired @@ -268,7 +271,7 @@ JavaObject parameter = new JavaObject("Lisp is fun!"); LispObject result = fooFunction.execute(parameter); // How to get the "naked string value"? - System.out.prinln("The result was " + result.writeToString()); + System.out.println("The result was " + result.writeToString()); \end{code} If one is calling an primitive function in the CL package the syntax @@ -401,6 +404,18 @@ ? \end[java]{code} +\subsubsection{Extensions to the Reader} + +We implement a special hexadecimal escape sequence for specifying +characters to the Lisp reader, namely we allow a sequences of the form +#\Uxxxx to be processed by the reader as character whose code is +specified by the hexadecimal digits `xxxx'. The hexadecimal sequence +must be exactly four digits long, padded by leading zeros for values +less than 0x1000. + +Note that this sequence is never output by the implementation. Instead, +the corresponding Unicode character is output for characters whose +code is greater than 0x00ff. \section{Multithreading} @@ -409,6 +424,17 @@ \section{History} +ABCL was originally the extension language for the J editor, which was +started in 1998 by Peter Graves. Sometime in 2003, it seems that a +lot of code that had previously not been released publically was +suddenly committed that enabled ABCL to be plausibly termed an ANSI +Common Lisp implementation. + +In 2006, the implementation was transferred to the current +maintainers, who have strived to improve its usability as a +contemporary Common Lisp implementation. + + \end{document} % TODO Modified: branches/0.26.x/abcl/src/org/armedbear/lisp/LispCharacter.java ============================================================================== --- branches/0.26.x/abcl/src/org/armedbear/lisp/LispCharacter.java Tue Jul 26 11:50:04 2011 (r13415) +++ branches/0.26.x/abcl/src/org/armedbear/lisp/LispCharacter.java Tue Jul 26 12:55:04 2011 (r13416) @@ -626,12 +626,7 @@ return "Rubout"; } - if (c > 255) { - final String result = "0000" + Integer.toString(c, 16); - return "U" + result.substring(result.length() - 4, result.length()); - } - - if (c<0) return null; + if (c<0 || c>255) return null; return lispChars.get(c).name; } Modified: branches/0.26.x/abcl/test/lisp/ansi/ansi-test-failures ============================================================================== --- branches/0.26.x/abcl/test/lisp/ansi/ansi-test-failures Tue Jul 26 11:50:04 2011 (r13415) +++ branches/0.26.x/abcl/test/lisp/ansi/ansi-test-failures Tue Jul 26 12:55:04 2011 (r13416) @@ -358,3 +358,73 @@ FORMAT.LOGICAL-BLOCK.CIRCLE.1 FORMAT.LOGICAL-BLOCK.CIRCLE.2 FORMAT.LOGICAL-BLOCK.CIRCLE.3 WITH-STANDARD-IO-SYNTAX.23 TRACE.8)) +(doit 0.25.0 :id saturn + :uname "i386-pc-solaris2.11.oi_148" :jvm "jdk-1.6.0_25" + (DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 DEFGENERIC.30 + CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 + MAKE-CONDITION.3 MAKE-CONDITION.4 DELETE-PACKAGE.5 + DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 MAKE-PATHNAME.9 + ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.2 + PRINT.RANDOM-STATE.1 PPRINT-FILL.14 PPRINT-FILL.15 + PPRINT-LINEAR.14 PPRINT-TABULAR.13 PPRINT-LOGICAL-BLOCK.17 + PPRINT-POP.7 PPRINT-POP.8 FORMAT.LOGICAL-BLOCK.CIRCLE.1 + FORMAT.LOGICAL-BLOCK.CIRCLE.2 FORMAT.LOGICAL-BLOCK.CIRCLE.3 + COMPILE-FILE.16)) + +(compileit 0.25.0 :id saturn + :uname "i386-pc-solaris2.11.oi_148" :jvm "jdk-1.6.0_25" + (MULTIPLE-VALUE-PROG1.10 DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 + DEFGENERIC.30 CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 + MAKE-CONDITION.3 MAKE-CONDITION.4 DELETE-PACKAGE.5 + DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 MAKE-PATHNAME.9 + ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.2 + PRINT.SYMBOL.RANDOM.4 PRINT.STRING.RANDOM.1 PRINT.RANDOM-STATE.1 + PPRINT-FILL.14 PPRINT-FILL.15 PPRINT-LINEAR.14 PPRINT-TABULAR.13 + PPRINT-LOGICAL-BLOCK.17 PPRINT-POP.7 PPRINT-POP.8 + FORMAT.LOGICAL-BLOCK.CIRCLE.1 FORMAT.LOGICAL-BLOCK.CIRCLE.2 + FORMAT.LOGICAL-BLOCK.CIRCLE.3 COMPILE-FILE.16 TRACE.8)) + +(doit 0.26.1 :id saturn + (DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 DEFGENERIC.30 + CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 MAKE-CONDITION.3 + MAKE-CONDITION.4 DELETE-PACKAGE.5 DELETE-PACKAGE.6 MAP.48 + TYPE-OF.1 TYPE-OF.4 ENSURE-DIRECTORIES-EXIST.8 + PRINT.SYMBOL.RANDOM.2 PRINT.RANDOM-STATE.1 + PPRINT-LOGICAL-BLOCK.17 FORMAT.C.2A FORMATTER.C.2A)) + +(compileit 0.26.1 :id saturn + (MULTIPLE-VALUE-PROG1.10 DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 + DEFGENERIC.30 CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 MAKE-CONDITION.3 + MAKE-CONDITION.4 DELETE-PACKAGE.5 DELETE-PACKAGE.6 MAP.48 + TYPE-OF.1 TYPE-OF.4 ENSURE-DIRECTORIES-EXIST.8 + PRINT.RANDOM-STATE.1 PPRINT-LOGICAL-BLOCK.17 FORMAT.C.2A + FORMATTER.C.2A TRACE.8)) + +(doit 0.27.0-dev-13414M :id saturn + (DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 DEFGENERIC.30 + CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 DEFMETHOD.ERROR.14 + DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 MAKE-CONDITION.3 MAKE-CONDITION.4 + DELETE-PACKAGE.5 DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 + ENSURE-DIRECTORIES-EXIST.8 PRINT.RANDOM-STATE.1 + PPRINT-LOGICAL-BLOCK.17)) + +(compileit 0.27.0-dev-13414M :id saturn + (ETYPECASE.15 MULTIPLE-VALUE-PROG1.10 DEFGENERIC.ERROR.20 + DEFGENERIC.ERROR.21 DEFGENERIC.30 CALL-NEXT-METHOD.ERROR.1 + CALL-NEXT-METHOD.ERROR.2 DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 + INVOKE-DEBUGGER.1 MAKE-CONDITION.3 MAKE-CONDITION.4 + DELETE-PACKAGE.5 DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 + ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.2 + PRINT.SYMBOL.RANDOM.3 PRINT.SYMBOL.RANDOM.4 + PRINT.RANDOM-STATE.1 PPRINT-LOGICAL-BLOCK.17 TRACE.8)) + + + + + + + From mevenson at common-lisp.net Wed Jul 27 06:44:51 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 26 Jul 2011 23:44:51 -0700 Subject: [armedbear-cvs] r13417 - in trunk/abcl: doc/asdf src/org/armedbear/lisp Message-ID: Author: mevenson Date: Tue Jul 26 23:44:50 2011 New Revision: 13417 Log: Upgrade to asdf-2.017. Modified: trunk/abcl/doc/asdf/asdf.texinfo trunk/abcl/src/org/armedbear/lisp/asdf.lisp Modified: trunk/abcl/doc/asdf/asdf.texinfo ============================================================================== --- trunk/abcl/doc/asdf/asdf.texinfo Tue Jul 26 12:55:04 2011 (r13416) +++ trunk/abcl/doc/asdf/asdf.texinfo Tue Jul 26 23:44:50 2011 (r13417) @@ -431,7 +431,7 @@ and the machine you resume it at the time you resume it. - at section Configuring ASDF to find your systems -- old style + at section Configuring ASDF to find your systems --- old style The old way to configure ASDF to find your systems is by @code{push}ing directory pathnames onto the variable @@ -498,7 +498,8 @@ to the @code{asdf:*central-registry*}. ASDF knows how to follow such @emph{symlinks} to the actual file location when resolving the paths of system components -(on Windows, you can use Windows shortcuts instead of POSIX symlinks). +(on Windows, you can use Windows shortcuts instead of POSIX symlinks; +if you try aliases under MacOS, we are curious to hear about your experience). For example, if @code{#p"/home/me/cl/systems/"} (note the trailing slash) is a member of @code{*central-registry*}, you could set up the @@ -1898,7 +1899,7 @@ @code{asdf:*central-registry*} before it searches in the source registry above. - at xref{Configuring ASDF,,Configuring ASDF to find your systems -- old style}. + at xref{Configuring ASDF,,Configuring ASDF to find your systems --- old style}. By default, @code{asdf:*central-registry*} will be empty. @@ -1937,9 +1938,9 @@ (:tree DIRECTORY-PATHNAME-DESIGNATOR) | ;; override the defaults for exclusion patterns - (:exclude PATTERN ...) | + (:exclude EXCLUSION-PATTERN ...) | ;; augment the defaults for exclusion patterns - (:also-exclude PATTERN ...) | + (:also-exclude EXCLUSION-PATTERN ...) | ;; Note that the scope of a an exclude pattern specification is ;; the rest of the current configuration expression or file. @@ -1953,35 +1954,56 @@ DIRECTORY-PATHNAME-DESIGNATOR := PATHNAME-DESIGNATOR ;; interpreted as a directory name PATHNAME-DESIGNATOR := - NULL | ;; Special: skip this entry. - ABSOLUTE-COMPONENT-DESIGNATOR | - (ABSOLUTE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...) + NIL | ;; Special: skip this entry. + ABSOLUTE-COMPONENT-DESIGNATOR ;; see pathname DSL +EXCLUSION-PATTERN := a string without wildcards, that will be matched exactly + against the name of a any subdirectory in the directory component + of a path. e.g. @code{"_darcs"} will match @file{#p"/foo/bar/_darcs/src/bar.asd"} + at end example + +Pathnames are designated using another DSL, +shared with the output-translations configuration DSL below. +The DSL is resolved by the function @code{asdf::resolve-location}, +to be documented and exported at some point in the future. + + at example ABSOLUTE-COMPONENT-DESIGNATOR := - STRING | ;; namestring (better be absolute or bust, directory assumed where applicable) + (ABSOLUTE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...) | + STRING | ;; namestring (better be absolute or bust, directory assumed where applicable). + ;; In output-translations, directory is assumed and **/*.*.* added if it's last. + ;; On MCL, a MacOSX-style POSIX namestring (for MacOS9 style, use #p"..."); + ;; Note that none of the above applies to strings used in *central-registry*, + ;; which doesn't use this DSL: they are processed as normal namestrings. + ;; however, you can compute what you put in the *central-registry* + ;; based on the results of say (asdf::resolve-location "/Users/fare/cl/cl-foo/") PATHNAME | ;; pathname (better be an absolute path, or bust) + ;; In output-translations, unless followed by relative components, + ;; it better have appropriate wildcards, as in **/*.*.* :HOME | ;; designates the user-homedir-pathname ~/ :USER-CACHE | ;; designates the default location for the user cache - :SYSTEM-CACHE | ;; designates the default location for the system cache - :HERE ;; designates the location of the configuration file - ;; (or *default-pathname-defaults*, if invoked interactively) + :HERE | ;; designates the location of the configuration file + ;; (or *default-pathname-defaults*, if invoked interactively) + :ROOT ;; magic, for output-translations source only: paths that are relative + ;; to the root of the source host and device + ;; Not valid anymore: :SYSTEM-CACHE (was a security hazard) RELATIVE-COMPONENT-DESIGNATOR := - STRING | ;; namestring (directory assumed where applicable) - PATHNAME | ;; pathname - :IMPLEMENTATION | ;; a directory based on implementation, e.g. sbcl-1.0.45-linux-amd64 + (RELATIVE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...) | + STRING | ;; relative directory pathname as interpreted by coerce-pathname. + ;; In output translations, if last component, **/*.*.* is added + PATHNAME | ;; pathname; unless last component, directory is assumed. + :IMPLEMENTATION | ;; directory based on implementation, e.g. sbcl-1.0.49-linux-x64 :IMPLEMENTATION-TYPE | ;; a directory based on lisp-implementation-type only, e.g. sbcl - :UID | ;; current UID -- not available on Windows - :USER ;; current USER name -- NOT IMPLEMENTED(!) - -PATTERN := a string without wildcards, that will be matched exactly - against the name of a any subdirectory in the directory component - of a path. e.g. @code{"_darcs"} will match @file{#p"/foo/bar/_darcs/src/bar.asd"} + :DEFAULT-DIRECTORY | ;; a relativized version of the default directory + :*/ | ;; any direct subdirectory (since ASDF 2.011.4) + :**/ | ;; any recursively inferior subdirectory (since ASDF 2.011.4) + :*.*.* | ;; any file (since ASDF 2.011.4) + ;; Not supported (anymore): :UID and :USERNAME @end example For instance, as a simple case, my @file{~/.config/common-lisp/source-registry.conf}, -which is the default place ASDF looks for this configuration, -once contained: +which is the default place ASDF looks for this configuration, once contained: @example (:source-registry (:tree (:home "cl")) ;; will expand to e.g. "/home/joeluser/cl/" @@ -2453,29 +2475,9 @@ (DIRECTORY-DESIGNATOR (:function TRANSLATION-FUNCTION)) DIRECTORY-DESIGNATOR := + NIL | ;; As source: skip this entry. As destination: same as source T | ;; as source matches anything, as destination leaves pathname unmapped. - ABSOLUTE-COMPONENT-DESIGNATOR | - (ABSOLUTE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...) - -ABSOLUTE-COMPONENT-DESIGNATOR := - NULL | ;; As source: skip this entry. As destination: same as source - :ROOT | ;; magic: paths that are relative to the root of the source host and device - STRING | ;; namestring (directory is assumed, better be absolute or bust, ``/**/*.*'' added) - PATHNAME | ;; pathname (better be an absolute directory or bust) - :HOME | ;; designates the user-homedir-pathname ~/ - :USER-CACHE | ;; designates the default location for the user cache - :SYSTEM-CACHE ;; designates the default location for the system cache - -RELATIVE-COMPONENT-DESIGNATOR := - STRING | ;; namestring, directory is assumed. If the last component, /**/*.* is added - PATHNAME | ;; pathname; unless last component, directory is assumed. - :IMPLEMENTATION | ;; a directory based on implementation, e.g. sbcl-1.0.45-linux-amd64 - :IMPLEMENTATION-TYPE | ;; a directory based on lisp-implementation-type only, e.g. sbcl - :*/ | ;; any direct subdirectory (since ASDF 2.011.4) - :**/ | ;; any recursively inferior subdirectory (since ASDF 2.011.4) - :*.*.* | ;; any file (since ASDF 2.011.4) - :UID | ;; current UID -- not available on Windows - :USER ;; current USER name -- NOT IMPLEMENTED(!) + ABSOLUTE-COMPONENT-DESIGNATOR ;; same as in the source-registry language TRANSLATION-FUNCTION := SYMBOL | ;; symbol of a function that takes two arguments, @@ -3183,7 +3185,7 @@ or shallow @code{:tree} entries. Or you can fix your implementation to not be quite that slow when recursing through directories. - at underline{Update}: performance bug fixed the hard way in 2.010. + at emph{Update}: performance bug fixed the hard way in 2.010. @item On Windows, only LispWorks supports proper default configuration pathnames Modified: trunk/abcl/src/org/armedbear/lisp/asdf.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/asdf.lisp Tue Jul 26 12:55:04 2011 (r13416) +++ trunk/abcl/src/org/armedbear/lisp/asdf.lisp Tue Jul 26 23:44:50 2011 (r13417) @@ -1,5 +1,5 @@ ;;; -*- mode: common-lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- -;;; This is ASDF 2.016.1: Another System Definition Facility. +;;; This is ASDF 2.017: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to . @@ -50,7 +50,7 @@ (cl:in-package #-genera :common-lisp-user #+genera :future-common-lisp-user) #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl sbcl scl xcl) -(error "ASDF is not supported on your implementation. Please help us with it.") +(error "ASDF is not supported on your implementation. Please help us port it.") #+gcl (defpackage :asdf (:use :cl)) ;; GCL treats defpackage magically and needs this @@ -62,8 +62,8 @@ (remove "asdf" excl::*autoload-package-name-alist* :test 'equalp :key 'car)) ; need that BEFORE any mention of package ASDF as below #+(and ecl (not ecl-bytecmp)) (require :cmp) - #+gcl - (when (or (< system::*gcl-major-version* 2) + #+gcl ;; Debian's GCL 2.7 has bugs with compiling multiple-value stuff, but can run ASDF 2.011 + (when (or (< system::*gcl-major-version* 2) ;; GCL 2.6 fails to fully compile ASDF at all (and (= system::*gcl-major-version* 2) (< system::*gcl-minor-version* 7))) (pushnew :gcl-pre2.7 *features*)) @@ -112,7 +112,7 @@ ;; "2.345.6" would be a development version in the official upstream ;; "2.345.0.7" would be your seventh local modification of official release 2.345 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 - (asdf-version "2.016.1") + (asdf-version "2.017") (existing-asdf (find-class 'component nil)) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version))) @@ -200,12 +200,13 @@ :do (unintern old user))) (loop :for x :in newly-exported-symbols :do (export (intern* x package))))) - (ensure-package (name &key nicknames use unintern fmakunbound shadow export) + (ensure-package (name &key nicknames use unintern fmakunbound + shadow export redefined-functions) (let* ((p (ensure-exists name nicknames use))) (ensure-unintern p unintern) (ensure-shadow p shadow) (ensure-export p export) - (ensure-fmakunbound p fmakunbound) + (ensure-fmakunbound p (append fmakunbound redefined-functions)) p))) (macrolet ((pkgdcl (name &key nicknames use export @@ -213,8 +214,9 @@ `(ensure-package ',name :nicknames ',nicknames :use ',use :export ',export :shadow ',shadow - :unintern ',(append #-(or gcl ecl) redefined-functions unintern) - :fmakunbound ',(append fmakunbound)))) + :unintern ',unintern + :redefined-functions ',redefined-functions + :fmakunbound ',fmakunbound))) (pkgdcl :asdf :nicknames (:asdf-utilities) ;; DEPRECATED! Do not use, for backward compatibility only. @@ -348,7 +350,6 @@ ;; #:ends-with #:ensure-directory-pathname #:getenv - ;; #:get-uid ;; #:length=n-p ;; #:find-symbol* #:merge-pathnames* @@ -419,7 +420,7 @@ (ftype (function (t t) t) (setf module-components-by-name))) ;;;; ------------------------------------------------------------------------- -;;;; Compatibility with Corman Lisp +;;;; Compatibility various implementations #+cormanlisp (progn (deftype logical-pathname () nil) @@ -428,6 +429,25 @@ (setf p (pathname p)) (format nil "~@[~A~]~@[.~A~]" (pathname-name p) (pathname-type p)))) +#.(or #+mcl ;; the #$ doesn't work on other lisps, even protected by #+mcl + (read-from-string + "(eval-when (:compile-toplevel :load-toplevel :execute) + (ccl:define-entry-point (_getenv \"getenv\") ((name :string)) :string) + (ccl:define-entry-point (_system \"system\") ((name :string)) :int) + ;; Note: ASDF may expect user-homedir-pathname to provide + ;; the pathname of the current user's home directory, whereas + ;; MCL by default provides the directory from which MCL was started. + ;; See http://code.google.com/p/mcl/wiki/Portability + (defun current-user-homedir-pathname () + (ccl::findfolder #$kuserdomain #$kCurrentUserFolderType)) + (defun probe-posix (posix-namestring) + \"If a file exists for the posix namestring, return the pathname\" + (ccl::with-cstrs ((cpath posix-namestring)) + (ccl::rlet ((is-dir :boolean) + (fsref :fsref)) + (when (eq #$noerr (#_fspathmakeref cpath fsref is-dir)) + (ccl::%path-from-fsref fsref is-dir))))))")) + ;;;; ------------------------------------------------------------------------- ;;;; General Purpose Utilities @@ -553,7 +573,6 @@ '(:relative :back) (pathname-directory pathname)) :defaults pathname))) - (define-modify-macro appendf (&rest args) append "Append onto list") ;; only to be used on short lists. @@ -654,10 +673,6 @@ :unless (eq k key) :append (list k v))) -#+mcl -(eval-when (:compile-toplevel :load-toplevel :execute) - (ccl:define-entry-point (_getenv "getenv") ((name :string)) :string)) - (defun* getenv (x) (declare (ignorable x)) #+(or abcl clisp xcl) (ext:getenv x) @@ -754,30 +769,6 @@ :until (eq form eof) :collect form))) -#+asdf-unix -(progn - #+ecl #.(cl:and (cl:< ext:+ecl-version-number+ 100601) - '(ffi:clines "#include " "#include ")) - (defun* get-uid () - #+allegro (excl.osi:getuid) - #+ccl (ccl::getuid) - #+clisp (loop :for s :in '("posix:uid" "LINUX:getuid") - :for f = (ignore-errors (read-from-string s)) - :when f :return (funcall f)) - #+(or cmu scl) (unix:unix-getuid) - #+ecl #.(cl:if (cl:< ext:+ecl-version-number+ 100601) - '(ffi:c-inline () () :int "getuid()" :one-liner t) - '(ext::getuid)) - #+sbcl (sb-unix:unix-getuid) - #-(or allegro ccl clisp cmu ecl sbcl scl) - (let ((uid-string - (with-output-to-string (*verbose-out*) - (run-shell-command "id -ur")))) - (with-input-from-string (stream uid-string) - (read-line stream) - (handler-case (parse-integer (read-line stream)) - (error () (error "Unable to find out user ID"))))))) - (defun* pathname-root (pathname) (make-pathname :directory '(:absolute) :name nil :type nil :version nil @@ -1432,11 +1423,9 @@ (defun* probe-asd (name defaults) (block nil (when (directory-pathname-p defaults) - (let ((file - (make-pathname - :defaults defaults :version :newest :case :local - :name name - :type "asd"))) + (let ((file (make-pathname + :defaults defaults :name name + :version :newest :case :local :type "asd"))) (when (probe-file* file) (return file))) #+(and asdf-windows (not clisp)) @@ -1536,7 +1525,7 @@ (let ((*systems-being-defined* (make-hash-table :test 'equal))) (funcall thunk)))) -(defmacro with-system-definitions ((&optional) &body body) +(defmacro with-system-definitions (() &body body) `(call-with-system-definitions #'(lambda () , at body))) (defun* load-sysdef (name pathname) @@ -2371,7 +2360,7 @@ (t (asdf-message (compatfmt "~&~@<; ~@;Changed ASDF from version ~A to incompatible version ~A~@:>~%") version new-version))) - (let ((asdf (find-system :asdf))) + (let ((asdf (funcall (find-symbol* 'find-system :asdf) :asdf))) ;; invalidate all systems but ASDF itself (setf *defined-systems* (make-defined-systems-table)) (register-system asdf) @@ -2607,7 +2596,7 @@ components pathname default-component-class perform explain output-files operation-done-p weakly-depends-on - depends-on serial in-order-to + depends-on serial in-order-to do-first (version nil versionp) ;; list ends &allow-other-keys) options @@ -2668,7 +2657,10 @@ in-order-to `((compile-op (compile-op , at depends-on)) (load-op (load-op , at depends-on))))) - (setf (component-do-first ret) `((compile-op (load-op , at depends-on)))) + (setf (component-do-first ret) + (union-of-dependencies + do-first + `((compile-op (load-op , at depends-on))))) (%refresh-component-inline-methods ret rest) ret))) @@ -2752,6 +2744,13 @@ :input nil :output *verbose-out* :wait t))) + #+(or cmu scl) + (ext:process-exit-code + (ext:run-program + "/bin/sh" + (list "-c" command) + :input nil :output *verbose-out*)) + #+ecl ;; courtesy of Juan Jose Garcia Ripoll (si:system command) @@ -2766,6 +2765,9 @@ :prefix "" :output-stream *verbose-out*) + #+mcl + (ccl::with-cstrs ((%command command)) (_system %command)) + #+sbcl (sb-ext:process-exit-code (apply 'sb-ext:run-program @@ -2774,17 +2776,10 @@ :input nil :output *verbose-out* #+win32 '(:search t) #-win32 nil)) - #+(or cmu scl) - (ext:process-exit-code - (ext:run-program - "/bin/sh" - (list "-c" command) - :input nil :output *verbose-out*)) - #+xcl (ext:run-shell-command command) - #-(or abcl allegro clisp clozure cmu ecl gcl lispworks sbcl scl xcl) + #-(or abcl allegro clisp clozure cmu ecl gcl lispworks mcl sbcl scl xcl) (error "RUN-SHELL-COMMAND not implemented for this Lisp"))) ;;;; --------------------------------------------------------------------------- @@ -2812,9 +2807,7 @@ "Return a pathname object corresponding to the directory in which the system specification (.asd file) is located." - (make-pathname :name nil - :type nil - :defaults (system-source-file system-designator))) + (pathname-directory-pathname (system-source-file system-designator))) (defun* relativize-directory (directory) (cond @@ -2841,109 +2834,77 @@ ;;; implementation-identifier ;;; ;;; produce a string to identify current implementation. -;;; Initially stolen from SLIME's SWANK, hacked since. +;;; Initially stolen from SLIME's SWANK, rewritten since. +;;; The (car '(...)) idiom avoids unreachable code warnings. -(defparameter *implementation-features* - '((:abcl :armedbear) - (:acl :allegro) - (:mcl :digitool) ; before clozure, so it won't get preempted by ccl - (:ccl :clozure) - (:corman :cormanlisp) - (:lw :lispworks) - :clisp :cmu :ecl :gcl :sbcl :scl :symbolics :xcl)) - -(defparameter *os-features* - '(:cygwin (:win :windows :mswindows :win32 :mingw32) ;; shorten things on windows - (:solaris :sunos) - (:linux :linux-target) ;; for GCL at least, must appear before :bsd. - (:macosx :darwin :darwin-target :apple) - :freebsd :netbsd :openbsd :bsd - :unix - :genera)) - -(defparameter *architecture-features* - '((:x64 :amd64 :x86-64 :x86_64 :x8664-target #+(and clisp word-size=64) :pc386) - (:x86 :i386 :i486 :i586 :i686 :pentium3 :pentium4 :pc386 :iapx386 :x8632-target) - :hppa64 :hppa - (:ppc64 :ppc64-target) (:ppc32 :ppc32-target :ppc :powerpc) - :sparc64 (:sparc32 :sparc) - (:arm :arm-target) - (:java :java-1.4 :java-1.5 :java-1.6 :java-1.7) - :mipsel :mipseb :mips - :alpha - :imach)) +(defparameter *implementation-type* + (car '(#+abcl :abcl #+allegro :acl + #+clozure :ccl #+clisp :clisp #+cormanlisp :corman #+cmu :cmu + #+ecl :ecl #+gcl :gcl #+lispworks :lw #+mcl :mcl + #+sbcl :sbcl #+scl :scl #+symbolics :symbolic #+xcl :xcl))) + +(defparameter *operating-system* + (car '(#+cygwin :cygwin #+(or windows mswindows win32 mingw32) :win + #+(or linux linux-target) :linux ;; for GCL at least, must appear before :bsd. + #+(or macosx darwin darwin-target apple) :macosx ; also before :bsd + #+(or solaris sunos) :solaris + #+(or freebsd netbsd openbsd bsd) :bsd + #+unix :unix + #+genera :genera))) + +(defparameter *architecture* + (car '(#+(or amd64 x86-64 x86_64 x8664-target (and word-size=64 pc386)) :x64 + #+(or x86 i386 i486 i586 i686 pentium3 pentium4 pc386 iapx386 x8632-target) :x86 + #+hppa64 :hppa64 #+hppa :hppa + #+(or ppc64 ppc64-target) :ppc64 + #+(or ppc32 ppc32-target ppc powerpc) :ppc32 + #+sparc64 :sparc64 #+(or sparc32 sparc) :sparc32 + #+(or arm arm-target) :arm + #+(or java java-1.4 java-1.5 java-1.6 java-1.7) :java + #+mipsel :mispel #+mipseb :mipseb #+mips :mips + #+alpha :alpha #+imach :imach))) -(defun* lisp-version-string () +(defparameter *lisp-version-string* (let ((s (lisp-implementation-version))) (or - #+allegro (format nil - "~A~A~A" - excl::*common-lisp-version-number* - ;; ANSI vs MoDeRn - thanks to Robert Goldman and Charley Cox - (if (eq excl:*current-case-mode* - :case-sensitive-lower) "M" "A") - ;; Note if not using International ACL - ;; see http://www.franz.com/support/documentation/8.1/doc/operators/excl/ics-target-case.htm - (excl:ics-target-case - (:-ics "8") - (:+ics ""))) ; redundant? (if (member :64bit *features*) "-64bit" "")) + #+allegro + (format nil "~A~A~@[~A~]" + excl::*common-lisp-version-number* + ;; ANSI vs MoDeRn - thanks to Robert Goldman and Charley Cox + (if (eq excl:*current-case-mode* :case-sensitive-lower) "M" "A") + ;; Note if not using International ACL + ;; see http://www.franz.com/support/documentation/8.1/doc/operators/excl/ics-target-case.htm + (excl:ics-target-case (:-ics "8"))) #+armedbear (format nil "~a-fasl~a" s system::*fasl-version*) - #+clisp (subseq s 0 (position #\space s)) ; strip build information (date, etc.) - #+clozure (format nil "~d.~d-f~d" ; shorten for windows - ccl::*openmcl-major-version* - ccl::*openmcl-minor-version* - (logand ccl::fasl-version #xFF)) + #+clisp + (subseq s 0 (position #\space s)) ; strip build information (date, etc.) + #+clozure + (format nil "~d.~d-f~d" ; shorten for windows + ccl::*openmcl-major-version* + ccl::*openmcl-minor-version* + (logand ccl::fasl-version #xFF)) #+cmu (substitute #\- #\/ s) #+ecl (format nil "~A~@[-~A~]" s - (let ((vcs-id (ext:lisp-implementation-vcs-id))) - (when (>= (length vcs-id) 8) - (subseq vcs-id 0 8)))) + (let ((vcs-id (ext:lisp-implementation-vcs-id))) + (subseq vcs-id 0 (min (length vcs-id) 8)))) #+gcl (subseq s (1+ (position #\space s))) - #+genera (multiple-value-bind (major minor) (sct:get-system-version "System") - (format nil "~D.~D" major minor)) - ;; #+lispworks (format nil "~A~@[~A~]" s (when (member :lispworks-64bit *features*) "-64bit") #+mcl (subseq s 8) ; strip the leading "Version " - ;; #+sbcl (format nil "~a-fasl~d" s sb-fasl:+fasl-file-version+) ; f-f-v redundant w/ version + #+genera + (multiple-value-bind (major minor) (sct:get-system-version "System") + (format nil "~D.~D" major minor)) + #+mcl (subseq s 8) ; strip the leading "Version " s))) -(defun* first-feature (features) - (labels - ((fp (thing) - (etypecase thing - (symbol - (let ((feature (find thing *features*))) - (when feature (return-from fp feature)))) - ;; allows features to be lists of which the first - ;; member is the "main name", the rest being aliases - (cons - (dolist (subf thing) - (when (find subf *features*) (return-from fp (first thing)))))) - nil)) - (loop :for f :in features - :when (fp f) :return :it))) - (defun* implementation-type () - (first-feature *implementation-features*)) + *implementation-type*) (defun* implementation-identifier () - (labels - ((maybe-warn (value fstring &rest args) - (cond (value) - (t (apply 'warn fstring args) - "unknown")))) - (let ((lisp (maybe-warn (implementation-type) - (compatfmt "~@") - *implementation-features*)) - (os (maybe-warn (first-feature *os-features*) - (compatfmt "~@") *os-features*)) - (arch (or #-clisp - (maybe-warn (first-feature *architecture-features*) - (compatfmt "~@") - *architecture-features*))) - (version (maybe-warn (lisp-version-string) - "Don't know how to get Lisp implementation version."))) - (substitute-if - #\_ #'(lambda (x) (find x " /:\\(){}[]$#`'\"")) - (format nil "~(~a~@{~@[-~a~]~}~)" lisp version os arch))))) + (substitute-if + #\_ #'(lambda (x) (find x " /:;&^\\|?<>(){}[]$#`'\"")) + (format nil "~(~a~@{~@[-~a~]~}~)" + (or *implementation-type* (lisp-implementation-type)) + (or *lisp-version-string* (lisp-implementation-version)) + (or *operating-system* (software-type)) + (or *architecture* (machine-type))))) ;;; --------------------------------------------------------------------------- @@ -2953,14 +2914,6 @@ #+asdf-unix #\: #-asdf-unix #\;) -;; Note: ASDF may expect user-homedir-pathname to provide the pathname of -;; the current user's home directory, while MCL by default provides the -;; directory from which MCL was started. -;; See http://code.google.com/p/mcl/wiki/Portability -#.(or #+mcl ;; the #$ doesn't work on other implementations, even inside #+mcl - `(defun current-user-homedir-pathname () - ,(read-from-string "(ccl::findfolder #$kuserdomain #$kCurrentUserFolderType))"))) - (defun* user-homedir () (truenamize (pathname-directory-pathname @@ -3126,10 +3079,6 @@ (getenv "APPDATA")) "common-lisp" "cache" :implementation) '(:home ".cache" "common-lisp" :implementation)))) -(defvar *system-cache* - ;; No good default, plus there's a security problem - ;; with other users messing with such directories. - *user-cache*) (defun* output-translations () (car *output-translations*)) @@ -3160,35 +3109,32 @@ (values (or null pathname) &optional)) resolve-location)) -(defun* resolve-relative-location-component (super x &key directory wilden) - (let* ((r (etypecase x - (pathname x) - (string x) - (cons - (return-from resolve-relative-location-component - (if (null (cdr x)) +(defun* resolve-relative-location-component (x &key directory wilden) + (let ((r (etypecase x + (pathname x) + (string (coerce-pathname x :type (when directory :directory))) + (cons + (if (null (cdr x)) + (resolve-relative-location-component + (car x) :directory directory :wilden wilden) + (let* ((car (resolve-relative-location-component + (car x) :directory t :wilden nil))) + (merge-pathnames* (resolve-relative-location-component - super (car x) :directory directory :wilden wilden) - (let* ((car (resolve-relative-location-component - super (car x) :directory t :wilden nil)) - (cdr (resolve-relative-location-component - (merge-pathnames* car super) (cdr x) - :directory directory :wilden wilden))) - (merge-pathnames* cdr car))))) - ((eql :default-directory) - (relativize-pathname-directory (default-directory))) - ((eql :*/) *wild-directory*) - ((eql :**/) *wild-inferiors*) - ((eql :*.*.*) *wild-file*) - ((eql :implementation) (implementation-identifier)) - ((eql :implementation-type) (string-downcase (implementation-type))) - #+asdf-unix - ((eql :uid) (princ-to-string (get-uid))))) - (d (if (or (pathnamep x) (not directory)) r (ensure-directory-pathname r))) - (s (if (or (pathnamep x) (not wilden)) d (wilden d)))) - (when (and (absolute-pathname-p s) (not (pathname-match-p s (wilden super)))) - (error (compatfmt "~@") s super)) - (merge-pathnames* s super))) + (cdr x) :directory directory :wilden wilden) + car)))) + ((eql :default-directory) + (relativize-pathname-directory (default-directory))) + ((eql :*/) *wild-directory*) + ((eql :**/) *wild-inferiors*) + ((eql :*.*.*) *wild-file*) + ((eql :implementation) + (coerce-pathname (implementation-identifier) :type :directory)) + ((eql :implementation-type) + (coerce-pathname (string-downcase (implementation-type)) :type :directory))))) + (when (absolute-pathname-p r) + (error (compatfmt "~@") x)) + (if (or (pathnamep x) (not wilden)) r (wilden r)))) (defvar *here-directory* nil "This special variable is bound to the currect directory during calls to @@ -3199,17 +3145,19 @@ (let* ((r (etypecase x (pathname x) - (string (if directory (ensure-directory-pathname x) (parse-namestring x))) + (string (let ((p (#+mcl probe-posix #-mcl parse-namestring x))) + #+mcl (unless p (error "POSIX pathname ~S does not exist" x)) + (if directory (ensure-directory-pathname p) p))) (cons (return-from resolve-absolute-location-component (if (null (cdr x)) (resolve-absolute-location-component (car x) :directory directory :wilden wilden) - (let* ((car (resolve-absolute-location-component - (car x) :directory t :wilden nil)) - (cdr (resolve-relative-location-component - car (cdr x) :directory directory :wilden wilden))) - (merge-pathnames* cdr car))))) ; XXX why is this not just "cdr" ? + (merge-pathnames* + (resolve-relative-location-component + (cdr x) :directory directory :wilden wilden) + (resolve-absolute-location-component + (car x) :directory t :wilden nil))))) ((eql :root) ;; special magic! we encode such paths as relative pathnames, ;; but it means "relative to the root of the source pathname's host and device". @@ -3224,15 +3172,14 @@ :directory t :wilden nil)) ((eql :user-cache) (resolve-location *user-cache* :directory t :wilden nil)) ((eql :system-cache) - (warn "Using the :system-cache is deprecated. ~%~ -Please remove it from your ASDF configuration") - (resolve-location *system-cache* :directory t :wilden nil)) + (error "Using the :system-cache is deprecated. ~%~ +Please remove it from your ASDF configuration")) ((eql :default-directory) (default-directory)))) (s (if (and wilden (not (pathnamep x))) (wilden r) r))) (unless (absolute-pathname-p s) - (error (compatfmt "~@") s)) + (error (compatfmt "~@") x)) s)) (defun* resolve-location (x &key directory wilden) @@ -3244,8 +3191,10 @@ :for (component . morep) :on (cdr x) :for dir = (and (or morep directory) t) :for wild = (and wilden (not morep)) - :do (setf path (resolve-relative-location-component - path component :directory dir :wilden wild)) + :do (setf path (merge-pathnames* + (resolve-relative-location-component + component :directory dir :wilden wild) + path)) :finally (return path)))) (defun* location-designator-p (x) @@ -3735,9 +3684,35 @@ (defparameter *wild-asd* (make-pathname :directory nil :name *wild* :type "asd" :version :newest)) +(defun* filter-logical-directory-results (directory entries merger) + (if (typep directory 'logical-pathname) + ;; Try hard to not resolve logical-pathname into physical pathnames; + ;; otherwise logical-pathname users/lovers will be disappointed. + ;; If directory* could use some implementation-dependent magic, + ;; we will have logical pathnames already; otherwise, + ;; we only keep pathnames for which specifying the name and + ;; translating the LPN commute. + (loop :for f :in entries + :for p = (or (and (typep f 'logical-pathname) f) + (let* ((u (ignore-errors (funcall merger f)))) + (and u (equal (ignore-errors (truename u)) f) u))) + :when p :collect p) + entries)) + +(defun* directory-files (directory &optional (pattern *wild-file*)) + (when (wild-pathname-p directory) + (error "Invalid wild in ~S" directory)) + (unless (member (pathname-directory pattern) '(() (:relative)) :test 'equal) + (error "Invalid file pattern ~S" pattern)) + (let ((entries (ignore-errors (directory* (merge-pathnames* pattern directory))))) + (filter-logical-directory-results + directory entries + #'(lambda (f) + (make-pathname :defaults directory :version (pathname-version f) + :name (pathname-name f) :type (pathname-type f)))))) + (defun* directory-asd-files (directory) - (ignore-errors - (directory* (merge-pathnames* *wild-asd* directory)))) + (directory-files directory *wild-asd*)) (defun* subdirectories (directory) (let* ((directory (ensure-directory-pathname directory)) @@ -3765,7 +3740,17 @@ :when d :collect #+(or abcl allegro xcl) d #+genera (ensure-directory-pathname (first x)) #+(or cmu lispworks scl) x))) - dirs)) + (filter-logical-directory-results + directory dirs + (let ((prefix (normalize-pathname-directory-component + (pathname-directory directory)))) + #'(lambda (d) + (let ((dir (normalize-pathname-directory-component + (pathname-directory d)))) + (and (consp dir) (consp (cdr dir)) + (make-pathname + :defaults directory :name nil :type nil :version nil + :directory (append prefix (last dir)))))))))) (defun* collect-asds-in-directory (directory collect) (map () collect (directory-asd-files directory))) @@ -3992,7 +3977,15 @@ (register-asd-directory directory :recurse recurse :exclude exclude :collect #'(lambda (asd) - (let ((name (pathname-name asd))) + (let* ((name (pathname-name asd)) + (name (if (typep asd 'logical-pathname) + ;; logical pathnames are upper-case, + ;; at least in the CLHS and on SBCL, + ;; yet (coerce-name :foo) is lower-case. + ;; won't work well with (load-system "Foo") + ;; instead of (load-system 'foo) + (string-downcase name) + name))) (cond ((gethash name registry) ; already shadowed by something else nil) From mevenson at common-lisp.net Wed Jul 27 06:49:22 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 26 Jul 2011 23:49:22 -0700 Subject: [armedbear-cvs] r13418 - in branches/0.26.x/abcl: doc/asdf src/org/armedbear/lisp Message-ID: Author: mevenson Date: Tue Jul 26 23:49:22 2011 New Revision: 13418 Log: Backport r13417: Upgrade to asdf-2.017. Modified: branches/0.26.x/abcl/doc/asdf/asdf.texinfo branches/0.26.x/abcl/src/org/armedbear/lisp/asdf.lisp Modified: branches/0.26.x/abcl/doc/asdf/asdf.texinfo ============================================================================== --- branches/0.26.x/abcl/doc/asdf/asdf.texinfo Tue Jul 26 23:44:50 2011 (r13417) +++ branches/0.26.x/abcl/doc/asdf/asdf.texinfo Tue Jul 26 23:49:22 2011 (r13418) @@ -431,7 +431,7 @@ and the machine you resume it at the time you resume it. - at section Configuring ASDF to find your systems -- old style + at section Configuring ASDF to find your systems --- old style The old way to configure ASDF to find your systems is by @code{push}ing directory pathnames onto the variable @@ -498,7 +498,8 @@ to the @code{asdf:*central-registry*}. ASDF knows how to follow such @emph{symlinks} to the actual file location when resolving the paths of system components -(on Windows, you can use Windows shortcuts instead of POSIX symlinks). +(on Windows, you can use Windows shortcuts instead of POSIX symlinks; +if you try aliases under MacOS, we are curious to hear about your experience). For example, if @code{#p"/home/me/cl/systems/"} (note the trailing slash) is a member of @code{*central-registry*}, you could set up the @@ -1898,7 +1899,7 @@ @code{asdf:*central-registry*} before it searches in the source registry above. - at xref{Configuring ASDF,,Configuring ASDF to find your systems -- old style}. + at xref{Configuring ASDF,,Configuring ASDF to find your systems --- old style}. By default, @code{asdf:*central-registry*} will be empty. @@ -1937,9 +1938,9 @@ (:tree DIRECTORY-PATHNAME-DESIGNATOR) | ;; override the defaults for exclusion patterns - (:exclude PATTERN ...) | + (:exclude EXCLUSION-PATTERN ...) | ;; augment the defaults for exclusion patterns - (:also-exclude PATTERN ...) | + (:also-exclude EXCLUSION-PATTERN ...) | ;; Note that the scope of a an exclude pattern specification is ;; the rest of the current configuration expression or file. @@ -1953,35 +1954,56 @@ DIRECTORY-PATHNAME-DESIGNATOR := PATHNAME-DESIGNATOR ;; interpreted as a directory name PATHNAME-DESIGNATOR := - NULL | ;; Special: skip this entry. - ABSOLUTE-COMPONENT-DESIGNATOR | - (ABSOLUTE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...) + NIL | ;; Special: skip this entry. + ABSOLUTE-COMPONENT-DESIGNATOR ;; see pathname DSL +EXCLUSION-PATTERN := a string without wildcards, that will be matched exactly + against the name of a any subdirectory in the directory component + of a path. e.g. @code{"_darcs"} will match @file{#p"/foo/bar/_darcs/src/bar.asd"} + at end example + +Pathnames are designated using another DSL, +shared with the output-translations configuration DSL below. +The DSL is resolved by the function @code{asdf::resolve-location}, +to be documented and exported at some point in the future. + + at example ABSOLUTE-COMPONENT-DESIGNATOR := - STRING | ;; namestring (better be absolute or bust, directory assumed where applicable) + (ABSOLUTE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...) | + STRING | ;; namestring (better be absolute or bust, directory assumed where applicable). + ;; In output-translations, directory is assumed and **/*.*.* added if it's last. + ;; On MCL, a MacOSX-style POSIX namestring (for MacOS9 style, use #p"..."); + ;; Note that none of the above applies to strings used in *central-registry*, + ;; which doesn't use this DSL: they are processed as normal namestrings. + ;; however, you can compute what you put in the *central-registry* + ;; based on the results of say (asdf::resolve-location "/Users/fare/cl/cl-foo/") PATHNAME | ;; pathname (better be an absolute path, or bust) + ;; In output-translations, unless followed by relative components, + ;; it better have appropriate wildcards, as in **/*.*.* :HOME | ;; designates the user-homedir-pathname ~/ :USER-CACHE | ;; designates the default location for the user cache - :SYSTEM-CACHE | ;; designates the default location for the system cache - :HERE ;; designates the location of the configuration file - ;; (or *default-pathname-defaults*, if invoked interactively) + :HERE | ;; designates the location of the configuration file + ;; (or *default-pathname-defaults*, if invoked interactively) + :ROOT ;; magic, for output-translations source only: paths that are relative + ;; to the root of the source host and device + ;; Not valid anymore: :SYSTEM-CACHE (was a security hazard) RELATIVE-COMPONENT-DESIGNATOR := - STRING | ;; namestring (directory assumed where applicable) - PATHNAME | ;; pathname - :IMPLEMENTATION | ;; a directory based on implementation, e.g. sbcl-1.0.45-linux-amd64 + (RELATIVE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...) | + STRING | ;; relative directory pathname as interpreted by coerce-pathname. + ;; In output translations, if last component, **/*.*.* is added + PATHNAME | ;; pathname; unless last component, directory is assumed. + :IMPLEMENTATION | ;; directory based on implementation, e.g. sbcl-1.0.49-linux-x64 :IMPLEMENTATION-TYPE | ;; a directory based on lisp-implementation-type only, e.g. sbcl - :UID | ;; current UID -- not available on Windows - :USER ;; current USER name -- NOT IMPLEMENTED(!) - -PATTERN := a string without wildcards, that will be matched exactly - against the name of a any subdirectory in the directory component - of a path. e.g. @code{"_darcs"} will match @file{#p"/foo/bar/_darcs/src/bar.asd"} + :DEFAULT-DIRECTORY | ;; a relativized version of the default directory + :*/ | ;; any direct subdirectory (since ASDF 2.011.4) + :**/ | ;; any recursively inferior subdirectory (since ASDF 2.011.4) + :*.*.* | ;; any file (since ASDF 2.011.4) + ;; Not supported (anymore): :UID and :USERNAME @end example For instance, as a simple case, my @file{~/.config/common-lisp/source-registry.conf}, -which is the default place ASDF looks for this configuration, -once contained: +which is the default place ASDF looks for this configuration, once contained: @example (:source-registry (:tree (:home "cl")) ;; will expand to e.g. "/home/joeluser/cl/" @@ -2453,29 +2475,9 @@ (DIRECTORY-DESIGNATOR (:function TRANSLATION-FUNCTION)) DIRECTORY-DESIGNATOR := + NIL | ;; As source: skip this entry. As destination: same as source T | ;; as source matches anything, as destination leaves pathname unmapped. - ABSOLUTE-COMPONENT-DESIGNATOR | - (ABSOLUTE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...) - -ABSOLUTE-COMPONENT-DESIGNATOR := - NULL | ;; As source: skip this entry. As destination: same as source - :ROOT | ;; magic: paths that are relative to the root of the source host and device - STRING | ;; namestring (directory is assumed, better be absolute or bust, ``/**/*.*'' added) - PATHNAME | ;; pathname (better be an absolute directory or bust) - :HOME | ;; designates the user-homedir-pathname ~/ - :USER-CACHE | ;; designates the default location for the user cache - :SYSTEM-CACHE ;; designates the default location for the system cache - -RELATIVE-COMPONENT-DESIGNATOR := - STRING | ;; namestring, directory is assumed. If the last component, /**/*.* is added - PATHNAME | ;; pathname; unless last component, directory is assumed. - :IMPLEMENTATION | ;; a directory based on implementation, e.g. sbcl-1.0.45-linux-amd64 - :IMPLEMENTATION-TYPE | ;; a directory based on lisp-implementation-type only, e.g. sbcl - :*/ | ;; any direct subdirectory (since ASDF 2.011.4) - :**/ | ;; any recursively inferior subdirectory (since ASDF 2.011.4) - :*.*.* | ;; any file (since ASDF 2.011.4) - :UID | ;; current UID -- not available on Windows - :USER ;; current USER name -- NOT IMPLEMENTED(!) + ABSOLUTE-COMPONENT-DESIGNATOR ;; same as in the source-registry language TRANSLATION-FUNCTION := SYMBOL | ;; symbol of a function that takes two arguments, @@ -3183,7 +3185,7 @@ or shallow @code{:tree} entries. Or you can fix your implementation to not be quite that slow when recursing through directories. - at underline{Update}: performance bug fixed the hard way in 2.010. + at emph{Update}: performance bug fixed the hard way in 2.010. @item On Windows, only LispWorks supports proper default configuration pathnames Modified: branches/0.26.x/abcl/src/org/armedbear/lisp/asdf.lisp ============================================================================== --- branches/0.26.x/abcl/src/org/armedbear/lisp/asdf.lisp Tue Jul 26 23:44:50 2011 (r13417) +++ branches/0.26.x/abcl/src/org/armedbear/lisp/asdf.lisp Tue Jul 26 23:49:22 2011 (r13418) @@ -1,5 +1,5 @@ ;;; -*- mode: common-lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- -;;; This is ASDF 2.016.1: Another System Definition Facility. +;;; This is ASDF 2.017: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to . @@ -50,7 +50,7 @@ (cl:in-package #-genera :common-lisp-user #+genera :future-common-lisp-user) #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl sbcl scl xcl) -(error "ASDF is not supported on your implementation. Please help us with it.") +(error "ASDF is not supported on your implementation. Please help us port it.") #+gcl (defpackage :asdf (:use :cl)) ;; GCL treats defpackage magically and needs this @@ -62,8 +62,8 @@ (remove "asdf" excl::*autoload-package-name-alist* :test 'equalp :key 'car)) ; need that BEFORE any mention of package ASDF as below #+(and ecl (not ecl-bytecmp)) (require :cmp) - #+gcl - (when (or (< system::*gcl-major-version* 2) + #+gcl ;; Debian's GCL 2.7 has bugs with compiling multiple-value stuff, but can run ASDF 2.011 + (when (or (< system::*gcl-major-version* 2) ;; GCL 2.6 fails to fully compile ASDF at all (and (= system::*gcl-major-version* 2) (< system::*gcl-minor-version* 7))) (pushnew :gcl-pre2.7 *features*)) @@ -112,7 +112,7 @@ ;; "2.345.6" would be a development version in the official upstream ;; "2.345.0.7" would be your seventh local modification of official release 2.345 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 - (asdf-version "2.016.1") + (asdf-version "2.017") (existing-asdf (find-class 'component nil)) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version))) @@ -200,12 +200,13 @@ :do (unintern old user))) (loop :for x :in newly-exported-symbols :do (export (intern* x package))))) - (ensure-package (name &key nicknames use unintern fmakunbound shadow export) + (ensure-package (name &key nicknames use unintern fmakunbound + shadow export redefined-functions) (let* ((p (ensure-exists name nicknames use))) (ensure-unintern p unintern) (ensure-shadow p shadow) (ensure-export p export) - (ensure-fmakunbound p fmakunbound) + (ensure-fmakunbound p (append fmakunbound redefined-functions)) p))) (macrolet ((pkgdcl (name &key nicknames use export @@ -213,8 +214,9 @@ `(ensure-package ',name :nicknames ',nicknames :use ',use :export ',export :shadow ',shadow - :unintern ',(append #-(or gcl ecl) redefined-functions unintern) - :fmakunbound ',(append fmakunbound)))) + :unintern ',unintern + :redefined-functions ',redefined-functions + :fmakunbound ',fmakunbound))) (pkgdcl :asdf :nicknames (:asdf-utilities) ;; DEPRECATED! Do not use, for backward compatibility only. @@ -348,7 +350,6 @@ ;; #:ends-with #:ensure-directory-pathname #:getenv - ;; #:get-uid ;; #:length=n-p ;; #:find-symbol* #:merge-pathnames* @@ -419,7 +420,7 @@ (ftype (function (t t) t) (setf module-components-by-name))) ;;;; ------------------------------------------------------------------------- -;;;; Compatibility with Corman Lisp +;;;; Compatibility various implementations #+cormanlisp (progn (deftype logical-pathname () nil) @@ -428,6 +429,25 @@ (setf p (pathname p)) (format nil "~@[~A~]~@[.~A~]" (pathname-name p) (pathname-type p)))) +#.(or #+mcl ;; the #$ doesn't work on other lisps, even protected by #+mcl + (read-from-string + "(eval-when (:compile-toplevel :load-toplevel :execute) + (ccl:define-entry-point (_getenv \"getenv\") ((name :string)) :string) + (ccl:define-entry-point (_system \"system\") ((name :string)) :int) + ;; Note: ASDF may expect user-homedir-pathname to provide + ;; the pathname of the current user's home directory, whereas + ;; MCL by default provides the directory from which MCL was started. + ;; See http://code.google.com/p/mcl/wiki/Portability + (defun current-user-homedir-pathname () + (ccl::findfolder #$kuserdomain #$kCurrentUserFolderType)) + (defun probe-posix (posix-namestring) + \"If a file exists for the posix namestring, return the pathname\" + (ccl::with-cstrs ((cpath posix-namestring)) + (ccl::rlet ((is-dir :boolean) + (fsref :fsref)) + (when (eq #$noerr (#_fspathmakeref cpath fsref is-dir)) + (ccl::%path-from-fsref fsref is-dir))))))")) + ;;;; ------------------------------------------------------------------------- ;;;; General Purpose Utilities @@ -553,7 +573,6 @@ '(:relative :back) (pathname-directory pathname)) :defaults pathname))) - (define-modify-macro appendf (&rest args) append "Append onto list") ;; only to be used on short lists. @@ -654,10 +673,6 @@ :unless (eq k key) :append (list k v))) -#+mcl -(eval-when (:compile-toplevel :load-toplevel :execute) - (ccl:define-entry-point (_getenv "getenv") ((name :string)) :string)) - (defun* getenv (x) (declare (ignorable x)) #+(or abcl clisp xcl) (ext:getenv x) @@ -754,30 +769,6 @@ :until (eq form eof) :collect form))) -#+asdf-unix -(progn - #+ecl #.(cl:and (cl:< ext:+ecl-version-number+ 100601) - '(ffi:clines "#include " "#include ")) - (defun* get-uid () - #+allegro (excl.osi:getuid) - #+ccl (ccl::getuid) - #+clisp (loop :for s :in '("posix:uid" "LINUX:getuid") - :for f = (ignore-errors (read-from-string s)) - :when f :return (funcall f)) - #+(or cmu scl) (unix:unix-getuid) - #+ecl #.(cl:if (cl:< ext:+ecl-version-number+ 100601) - '(ffi:c-inline () () :int "getuid()" :one-liner t) - '(ext::getuid)) - #+sbcl (sb-unix:unix-getuid) - #-(or allegro ccl clisp cmu ecl sbcl scl) - (let ((uid-string - (with-output-to-string (*verbose-out*) - (run-shell-command "id -ur")))) - (with-input-from-string (stream uid-string) - (read-line stream) - (handler-case (parse-integer (read-line stream)) - (error () (error "Unable to find out user ID"))))))) - (defun* pathname-root (pathname) (make-pathname :directory '(:absolute) :name nil :type nil :version nil @@ -1432,11 +1423,9 @@ (defun* probe-asd (name defaults) (block nil (when (directory-pathname-p defaults) - (let ((file - (make-pathname - :defaults defaults :version :newest :case :local - :name name - :type "asd"))) + (let ((file (make-pathname + :defaults defaults :name name + :version :newest :case :local :type "asd"))) (when (probe-file* file) (return file))) #+(and asdf-windows (not clisp)) @@ -1536,7 +1525,7 @@ (let ((*systems-being-defined* (make-hash-table :test 'equal))) (funcall thunk)))) -(defmacro with-system-definitions ((&optional) &body body) +(defmacro with-system-definitions (() &body body) `(call-with-system-definitions #'(lambda () , at body))) (defun* load-sysdef (name pathname) @@ -2371,7 +2360,7 @@ (t (asdf-message (compatfmt "~&~@<; ~@;Changed ASDF from version ~A to incompatible version ~A~@:>~%") version new-version))) - (let ((asdf (find-system :asdf))) + (let ((asdf (funcall (find-symbol* 'find-system :asdf) :asdf))) ;; invalidate all systems but ASDF itself (setf *defined-systems* (make-defined-systems-table)) (register-system asdf) @@ -2607,7 +2596,7 @@ components pathname default-component-class perform explain output-files operation-done-p weakly-depends-on - depends-on serial in-order-to + depends-on serial in-order-to do-first (version nil versionp) ;; list ends &allow-other-keys) options @@ -2668,7 +2657,10 @@ in-order-to `((compile-op (compile-op , at depends-on)) (load-op (load-op , at depends-on))))) - (setf (component-do-first ret) `((compile-op (load-op , at depends-on)))) + (setf (component-do-first ret) + (union-of-dependencies + do-first + `((compile-op (load-op , at depends-on))))) (%refresh-component-inline-methods ret rest) ret))) @@ -2752,6 +2744,13 @@ :input nil :output *verbose-out* :wait t))) + #+(or cmu scl) + (ext:process-exit-code + (ext:run-program + "/bin/sh" + (list "-c" command) + :input nil :output *verbose-out*)) + #+ecl ;; courtesy of Juan Jose Garcia Ripoll (si:system command) @@ -2766,6 +2765,9 @@ :prefix "" :output-stream *verbose-out*) + #+mcl + (ccl::with-cstrs ((%command command)) (_system %command)) + #+sbcl (sb-ext:process-exit-code (apply 'sb-ext:run-program @@ -2774,17 +2776,10 @@ :input nil :output *verbose-out* #+win32 '(:search t) #-win32 nil)) - #+(or cmu scl) - (ext:process-exit-code - (ext:run-program - "/bin/sh" - (list "-c" command) - :input nil :output *verbose-out*)) - #+xcl (ext:run-shell-command command) - #-(or abcl allegro clisp clozure cmu ecl gcl lispworks sbcl scl xcl) + #-(or abcl allegro clisp clozure cmu ecl gcl lispworks mcl sbcl scl xcl) (error "RUN-SHELL-COMMAND not implemented for this Lisp"))) ;;;; --------------------------------------------------------------------------- @@ -2812,9 +2807,7 @@ "Return a pathname object corresponding to the directory in which the system specification (.asd file) is located." - (make-pathname :name nil - :type nil - :defaults (system-source-file system-designator))) + (pathname-directory-pathname (system-source-file system-designator))) (defun* relativize-directory (directory) (cond @@ -2841,109 +2834,77 @@ ;;; implementation-identifier ;;; ;;; produce a string to identify current implementation. -;;; Initially stolen from SLIME's SWANK, hacked since. +;;; Initially stolen from SLIME's SWANK, rewritten since. +;;; The (car '(...)) idiom avoids unreachable code warnings. -(defparameter *implementation-features* - '((:abcl :armedbear) - (:acl :allegro) - (:mcl :digitool) ; before clozure, so it won't get preempted by ccl - (:ccl :clozure) - (:corman :cormanlisp) - (:lw :lispworks) - :clisp :cmu :ecl :gcl :sbcl :scl :symbolics :xcl)) - -(defparameter *os-features* - '(:cygwin (:win :windows :mswindows :win32 :mingw32) ;; shorten things on windows - (:solaris :sunos) - (:linux :linux-target) ;; for GCL at least, must appear before :bsd. - (:macosx :darwin :darwin-target :apple) - :freebsd :netbsd :openbsd :bsd - :unix - :genera)) - -(defparameter *architecture-features* - '((:x64 :amd64 :x86-64 :x86_64 :x8664-target #+(and clisp word-size=64) :pc386) - (:x86 :i386 :i486 :i586 :i686 :pentium3 :pentium4 :pc386 :iapx386 :x8632-target) - :hppa64 :hppa - (:ppc64 :ppc64-target) (:ppc32 :ppc32-target :ppc :powerpc) - :sparc64 (:sparc32 :sparc) - (:arm :arm-target) - (:java :java-1.4 :java-1.5 :java-1.6 :java-1.7) - :mipsel :mipseb :mips - :alpha - :imach)) +(defparameter *implementation-type* + (car '(#+abcl :abcl #+allegro :acl + #+clozure :ccl #+clisp :clisp #+cormanlisp :corman #+cmu :cmu + #+ecl :ecl #+gcl :gcl #+lispworks :lw #+mcl :mcl + #+sbcl :sbcl #+scl :scl #+symbolics :symbolic #+xcl :xcl))) + +(defparameter *operating-system* + (car '(#+cygwin :cygwin #+(or windows mswindows win32 mingw32) :win + #+(or linux linux-target) :linux ;; for GCL at least, must appear before :bsd. + #+(or macosx darwin darwin-target apple) :macosx ; also before :bsd + #+(or solaris sunos) :solaris + #+(or freebsd netbsd openbsd bsd) :bsd + #+unix :unix + #+genera :genera))) + +(defparameter *architecture* + (car '(#+(or amd64 x86-64 x86_64 x8664-target (and word-size=64 pc386)) :x64 + #+(or x86 i386 i486 i586 i686 pentium3 pentium4 pc386 iapx386 x8632-target) :x86 + #+hppa64 :hppa64 #+hppa :hppa + #+(or ppc64 ppc64-target) :ppc64 + #+(or ppc32 ppc32-target ppc powerpc) :ppc32 + #+sparc64 :sparc64 #+(or sparc32 sparc) :sparc32 + #+(or arm arm-target) :arm + #+(or java java-1.4 java-1.5 java-1.6 java-1.7) :java + #+mipsel :mispel #+mipseb :mipseb #+mips :mips + #+alpha :alpha #+imach :imach))) -(defun* lisp-version-string () +(defparameter *lisp-version-string* (let ((s (lisp-implementation-version))) (or - #+allegro (format nil - "~A~A~A" - excl::*common-lisp-version-number* - ;; ANSI vs MoDeRn - thanks to Robert Goldman and Charley Cox - (if (eq excl:*current-case-mode* - :case-sensitive-lower) "M" "A") - ;; Note if not using International ACL - ;; see http://www.franz.com/support/documentation/8.1/doc/operators/excl/ics-target-case.htm - (excl:ics-target-case - (:-ics "8") - (:+ics ""))) ; redundant? (if (member :64bit *features*) "-64bit" "")) + #+allegro + (format nil "~A~A~@[~A~]" + excl::*common-lisp-version-number* + ;; ANSI vs MoDeRn - thanks to Robert Goldman and Charley Cox + (if (eq excl:*current-case-mode* :case-sensitive-lower) "M" "A") + ;; Note if not using International ACL + ;; see http://www.franz.com/support/documentation/8.1/doc/operators/excl/ics-target-case.htm + (excl:ics-target-case (:-ics "8"))) #+armedbear (format nil "~a-fasl~a" s system::*fasl-version*) - #+clisp (subseq s 0 (position #\space s)) ; strip build information (date, etc.) - #+clozure (format nil "~d.~d-f~d" ; shorten for windows - ccl::*openmcl-major-version* - ccl::*openmcl-minor-version* - (logand ccl::fasl-version #xFF)) + #+clisp + (subseq s 0 (position #\space s)) ; strip build information (date, etc.) + #+clozure + (format nil "~d.~d-f~d" ; shorten for windows + ccl::*openmcl-major-version* + ccl::*openmcl-minor-version* + (logand ccl::fasl-version #xFF)) #+cmu (substitute #\- #\/ s) #+ecl (format nil "~A~@[-~A~]" s - (let ((vcs-id (ext:lisp-implementation-vcs-id))) - (when (>= (length vcs-id) 8) - (subseq vcs-id 0 8)))) + (let ((vcs-id (ext:lisp-implementation-vcs-id))) + (subseq vcs-id 0 (min (length vcs-id) 8)))) #+gcl (subseq s (1+ (position #\space s))) - #+genera (multiple-value-bind (major minor) (sct:get-system-version "System") - (format nil "~D.~D" major minor)) - ;; #+lispworks (format nil "~A~@[~A~]" s (when (member :lispworks-64bit *features*) "-64bit") #+mcl (subseq s 8) ; strip the leading "Version " - ;; #+sbcl (format nil "~a-fasl~d" s sb-fasl:+fasl-file-version+) ; f-f-v redundant w/ version + #+genera + (multiple-value-bind (major minor) (sct:get-system-version "System") + (format nil "~D.~D" major minor)) + #+mcl (subseq s 8) ; strip the leading "Version " s))) -(defun* first-feature (features) - (labels - ((fp (thing) - (etypecase thing - (symbol - (let ((feature (find thing *features*))) - (when feature (return-from fp feature)))) - ;; allows features to be lists of which the first - ;; member is the "main name", the rest being aliases - (cons - (dolist (subf thing) - (when (find subf *features*) (return-from fp (first thing)))))) - nil)) - (loop :for f :in features - :when (fp f) :return :it))) - (defun* implementation-type () - (first-feature *implementation-features*)) + *implementation-type*) (defun* implementation-identifier () - (labels - ((maybe-warn (value fstring &rest args) - (cond (value) - (t (apply 'warn fstring args) - "unknown")))) - (let ((lisp (maybe-warn (implementation-type) - (compatfmt "~@") - *implementation-features*)) - (os (maybe-warn (first-feature *os-features*) - (compatfmt "~@") *os-features*)) - (arch (or #-clisp - (maybe-warn (first-feature *architecture-features*) - (compatfmt "~@") - *architecture-features*))) - (version (maybe-warn (lisp-version-string) - "Don't know how to get Lisp implementation version."))) - (substitute-if - #\_ #'(lambda (x) (find x " /:\\(){}[]$#`'\"")) - (format nil "~(~a~@{~@[-~a~]~}~)" lisp version os arch))))) + (substitute-if + #\_ #'(lambda (x) (find x " /:;&^\\|?<>(){}[]$#`'\"")) + (format nil "~(~a~@{~@[-~a~]~}~)" + (or *implementation-type* (lisp-implementation-type)) + (or *lisp-version-string* (lisp-implementation-version)) + (or *operating-system* (software-type)) + (or *architecture* (machine-type))))) ;;; --------------------------------------------------------------------------- @@ -2953,14 +2914,6 @@ #+asdf-unix #\: #-asdf-unix #\;) -;; Note: ASDF may expect user-homedir-pathname to provide the pathname of -;; the current user's home directory, while MCL by default provides the -;; directory from which MCL was started. -;; See http://code.google.com/p/mcl/wiki/Portability -#.(or #+mcl ;; the #$ doesn't work on other implementations, even inside #+mcl - `(defun current-user-homedir-pathname () - ,(read-from-string "(ccl::findfolder #$kuserdomain #$kCurrentUserFolderType))"))) - (defun* user-homedir () (truenamize (pathname-directory-pathname @@ -3126,10 +3079,6 @@ (getenv "APPDATA")) "common-lisp" "cache" :implementation) '(:home ".cache" "common-lisp" :implementation)))) -(defvar *system-cache* - ;; No good default, plus there's a security problem - ;; with other users messing with such directories. - *user-cache*) (defun* output-translations () (car *output-translations*)) @@ -3160,35 +3109,32 @@ (values (or null pathname) &optional)) resolve-location)) -(defun* resolve-relative-location-component (super x &key directory wilden) - (let* ((r (etypecase x - (pathname x) - (string x) - (cons - (return-from resolve-relative-location-component - (if (null (cdr x)) +(defun* resolve-relative-location-component (x &key directory wilden) + (let ((r (etypecase x + (pathname x) + (string (coerce-pathname x :type (when directory :directory))) + (cons + (if (null (cdr x)) + (resolve-relative-location-component + (car x) :directory directory :wilden wilden) + (let* ((car (resolve-relative-location-component + (car x) :directory t :wilden nil))) + (merge-pathnames* (resolve-relative-location-component - super (car x) :directory directory :wilden wilden) - (let* ((car (resolve-relative-location-component - super (car x) :directory t :wilden nil)) - (cdr (resolve-relative-location-component - (merge-pathnames* car super) (cdr x) - :directory directory :wilden wilden))) - (merge-pathnames* cdr car))))) - ((eql :default-directory) - (relativize-pathname-directory (default-directory))) - ((eql :*/) *wild-directory*) - ((eql :**/) *wild-inferiors*) - ((eql :*.*.*) *wild-file*) - ((eql :implementation) (implementation-identifier)) - ((eql :implementation-type) (string-downcase (implementation-type))) - #+asdf-unix - ((eql :uid) (princ-to-string (get-uid))))) - (d (if (or (pathnamep x) (not directory)) r (ensure-directory-pathname r))) - (s (if (or (pathnamep x) (not wilden)) d (wilden d)))) - (when (and (absolute-pathname-p s) (not (pathname-match-p s (wilden super)))) - (error (compatfmt "~@") s super)) - (merge-pathnames* s super))) + (cdr x) :directory directory :wilden wilden) + car)))) + ((eql :default-directory) + (relativize-pathname-directory (default-directory))) + ((eql :*/) *wild-directory*) + ((eql :**/) *wild-inferiors*) + ((eql :*.*.*) *wild-file*) + ((eql :implementation) + (coerce-pathname (implementation-identifier) :type :directory)) + ((eql :implementation-type) + (coerce-pathname (string-downcase (implementation-type)) :type :directory))))) + (when (absolute-pathname-p r) + (error (compatfmt "~@") x)) + (if (or (pathnamep x) (not wilden)) r (wilden r)))) (defvar *here-directory* nil "This special variable is bound to the currect directory during calls to @@ -3199,17 +3145,19 @@ (let* ((r (etypecase x (pathname x) - (string (if directory (ensure-directory-pathname x) (parse-namestring x))) + (string (let ((p (#+mcl probe-posix #-mcl parse-namestring x))) + #+mcl (unless p (error "POSIX pathname ~S does not exist" x)) + (if directory (ensure-directory-pathname p) p))) (cons (return-from resolve-absolute-location-component (if (null (cdr x)) (resolve-absolute-location-component (car x) :directory directory :wilden wilden) - (let* ((car (resolve-absolute-location-component - (car x) :directory t :wilden nil)) - (cdr (resolve-relative-location-component - car (cdr x) :directory directory :wilden wilden))) - (merge-pathnames* cdr car))))) ; XXX why is this not just "cdr" ? + (merge-pathnames* + (resolve-relative-location-component + (cdr x) :directory directory :wilden wilden) + (resolve-absolute-location-component + (car x) :directory t :wilden nil))))) ((eql :root) ;; special magic! we encode such paths as relative pathnames, ;; but it means "relative to the root of the source pathname's host and device". @@ -3224,15 +3172,14 @@ :directory t :wilden nil)) ((eql :user-cache) (resolve-location *user-cache* :directory t :wilden nil)) ((eql :system-cache) - (warn "Using the :system-cache is deprecated. ~%~ -Please remove it from your ASDF configuration") - (resolve-location *system-cache* :directory t :wilden nil)) + (error "Using the :system-cache is deprecated. ~%~ +Please remove it from your ASDF configuration")) ((eql :default-directory) (default-directory)))) (s (if (and wilden (not (pathnamep x))) (wilden r) r))) (unless (absolute-pathname-p s) - (error (compatfmt "~@") s)) + (error (compatfmt "~@") x)) s)) (defun* resolve-location (x &key directory wilden) @@ -3244,8 +3191,10 @@ :for (component . morep) :on (cdr x) :for dir = (and (or morep directory) t) :for wild = (and wilden (not morep)) - :do (setf path (resolve-relative-location-component - path component :directory dir :wilden wild)) + :do (setf path (merge-pathnames* + (resolve-relative-location-component + component :directory dir :wilden wild) + path)) :finally (return path)))) (defun* location-designator-p (x) @@ -3735,9 +3684,35 @@ (defparameter *wild-asd* (make-pathname :directory nil :name *wild* :type "asd" :version :newest)) +(defun* filter-logical-directory-results (directory entries merger) + (if (typep directory 'logical-pathname) + ;; Try hard to not resolve logical-pathname into physical pathnames; + ;; otherwise logical-pathname users/lovers will be disappointed. + ;; If directory* could use some implementation-dependent magic, + ;; we will have logical pathnames already; otherwise, + ;; we only keep pathnames for which specifying the name and + ;; translating the LPN commute. + (loop :for f :in entries + :for p = (or (and (typep f 'logical-pathname) f) + (let* ((u (ignore-errors (funcall merger f)))) + (and u (equal (ignore-errors (truename u)) f) u))) + :when p :collect p) + entries)) + +(defun* directory-files (directory &optional (pattern *wild-file*)) + (when (wild-pathname-p directory) + (error "Invalid wild in ~S" directory)) + (unless (member (pathname-directory pattern) '(() (:relative)) :test 'equal) + (error "Invalid file pattern ~S" pattern)) + (let ((entries (ignore-errors (directory* (merge-pathnames* pattern directory))))) + (filter-logical-directory-results + directory entries + #'(lambda (f) + (make-pathname :defaults directory :version (pathname-version f) + :name (pathname-name f) :type (pathname-type f)))))) + (defun* directory-asd-files (directory) - (ignore-errors - (directory* (merge-pathnames* *wild-asd* directory)))) + (directory-files directory *wild-asd*)) (defun* subdirectories (directory) (let* ((directory (ensure-directory-pathname directory)) @@ -3765,7 +3740,17 @@ :when d :collect #+(or abcl allegro xcl) d #+genera (ensure-directory-pathname (first x)) #+(or cmu lispworks scl) x))) - dirs)) + (filter-logical-directory-results + directory dirs + (let ((prefix (normalize-pathname-directory-component + (pathname-directory directory)))) + #'(lambda (d) + (let ((dir (normalize-pathname-directory-component + (pathname-directory d)))) + (and (consp dir) (consp (cdr dir)) + (make-pathname + :defaults directory :name nil :type nil :version nil + :directory (append prefix (last dir)))))))))) (defun* collect-asds-in-directory (directory collect) (map () collect (directory-asd-files directory))) @@ -3992,7 +3977,15 @@ (register-asd-directory directory :recurse recurse :exclude exclude :collect #'(lambda (asd) - (let ((name (pathname-name asd))) + (let* ((name (pathname-name asd)) + (name (if (typep asd 'logical-pathname) + ;; logical pathnames are upper-case, + ;; at least in the CLHS and on SBCL, + ;; yet (coerce-name :foo) is lower-case. + ;; won't work well with (load-system "Foo") + ;; instead of (load-system 'foo) + (string-downcase name) + name))) (cond ((gethash name registry) ; already shadowed by something else nil) From mevenson at common-lisp.net Wed Jul 27 06:51:14 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 26 Jul 2011 23:51:14 -0700 Subject: [armedbear-cvs] r13419 - branches/0.26.x/abcl Message-ID: Author: mevenson Date: Tue Jul 26 23:51:14 2011 New Revision: 13419 Log: Note ASDF and reader changes. Modified: branches/0.26.x/abcl/CHANGES Modified: branches/0.26.x/abcl/CHANGES ============================================================================== --- branches/0.26.x/abcl/CHANGES Tue Jul 26 23:49:22 2011 (r13418) +++ branches/0.26.x/abcl/CHANGES Tue Jul 26 23:51:14 2011 (r13419) @@ -2,6 +2,11 @@ ============== svn://common-lisp.net/project/armedbear/svn/tags/0.26.1/abcl +Features +-------- + + * Upgrade ASDF to 2.017. + Fixes ----- @@ -17,6 +22,10 @@ * String interop with Java for strings with fill pointer + * Made #\Uxxxx a synonym for character codes with values greater than + 255 on input, but never output as the character name by the + implementation. + Version 0.26.0 ============== svn://common-lisp.net/project/armedbear/svn/tags/0.26.0/abcl From mevenson at common-lisp.net Wed Jul 27 06:53:54 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 26 Jul 2011 23:53:54 -0700 Subject: [armedbear-cvs] r13420 - trunk/abcl Message-ID: Author: mevenson Date: Tue Jul 26 23:53:54 2011 New Revision: 13420 Log: Forwardport r13419: CHANGES from abcl-0.26.x branch. Modified: trunk/abcl/CHANGES Modified: trunk/abcl/CHANGES ============================================================================== --- trunk/abcl/CHANGES Tue Jul 26 23:51:14 2011 (r13419) +++ trunk/abcl/CHANGES Tue Jul 26 23:53:54 2011 (r13420) @@ -1,3 +1,31 @@ +Version 0.26.1 +============== +svn://common-lisp.net/project/armedbear/svn/tags/0.26.1/abcl + +Features +-------- + + * Upgrade ASDF to 2.017. + +Fixes +----- + + * Fix compilation problems by including the + org.armedbear.lisp.protocol source in the build process + + * Printing of conditions defined with DEFINE-CONDITION + + * Regression with failing SYNTAX.SHARP-BACKSLASH.6 + and SYNTAX.SHARP-BACKSLASH.7 ANSI test suite failures + + * Multiple failures in PPRINT.* ANSI test suite failures + + * String interop with Java for strings with fill pointer + + * Made #\Uxxxx a synonym for character codes with values greater than + 255 on input, but never output as the character name by the + implementation. + Version 0.26.0 ============== svn://common-lisp.net/project/armedbear/svn/tags/0.26.0/abcl From ehuelsmann at common-lisp.net Wed Jul 27 12:45:19 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Wed, 27 Jul 2011 05:45:19 -0700 Subject: [armedbear-cvs] r13421 - in tags/0.26.1: . abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Wed Jul 27 05:45:17 2011 New Revision: 13421 Log: Tag 0.26.1. Added: tags/0.26.1/ - copied from r13420, branches/0.26.x/ Modified: tags/0.26.1/abcl/src/org/armedbear/lisp/Version.java Modified: tags/0.26.1/abcl/src/org/armedbear/lisp/Version.java ============================================================================== --- branches/0.26.x/abcl/src/org/armedbear/lisp/Version.java Tue Jul 26 23:53:54 2011 (r13420) +++ tags/0.26.1/abcl/src/org/armedbear/lisp/Version.java Wed Jul 27 05:45:17 2011 (r13421) @@ -41,7 +41,7 @@ { private Version() {} - static final String baseVersion = "0.26.1-dev"; + static final String baseVersion = "0.26.1"; static void init() { try { From ehuelsmann at common-lisp.net Wed Jul 27 12:46:25 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Wed, 27 Jul 2011 05:46:25 -0700 Subject: [armedbear-cvs] r13422 - branches/0.26.x/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Wed Jul 27 05:46:24 2011 New Revision: 13422 Log: Increase branch version number to 0.26.2-dev. Modified: branches/0.26.x/abcl/src/org/armedbear/lisp/Version.java Modified: branches/0.26.x/abcl/src/org/armedbear/lisp/Version.java ============================================================================== --- branches/0.26.x/abcl/src/org/armedbear/lisp/Version.java Wed Jul 27 05:45:17 2011 (r13421) +++ branches/0.26.x/abcl/src/org/armedbear/lisp/Version.java Wed Jul 27 05:46:24 2011 (r13422) @@ -41,7 +41,7 @@ { private Version() {} - static final String baseVersion = "0.26.1-dev"; + static final String baseVersion = "0.26.2-dev"; static void init() { try { From ehuelsmann at common-lisp.net Wed Jul 27 13:31:16 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Wed, 27 Jul 2011 06:31:16 -0700 Subject: [armedbear-cvs] r13423 - in public_html/releases: 0.26.0 0.26.1 Message-ID: Author: ehuelsmann Date: Wed Jul 27 06:31:12 2011 New Revision: 13423 Log: Publish 0.26.1 distribution archives. Added: public_html/releases/0.26.1/ (props changed) public_html/releases/0.26.1/abcl-0.26.1.jar (contents, props changed) public_html/releases/0.26.1/abcl-0.26.1.jar.asc public_html/releases/0.26.1/abcl-bin-0.26.1.tar.gz (contents, props changed) public_html/releases/0.26.1/abcl-bin-0.26.1.tar.gz.asc public_html/releases/0.26.1/abcl-bin-0.26.1.zip (contents, props changed) public_html/releases/0.26.1/abcl-bin-0.26.1.zip.asc public_html/releases/0.26.1/abcl-contrib-0.26.1.jar (contents, props changed) public_html/releases/0.26.1/abcl-contrib-0.26.1.jar.asc public_html/releases/0.26.1/abcl-src-0.26.1.tar.gz (contents, props changed) public_html/releases/0.26.1/abcl-src-0.26.1.tar.gz.asc public_html/releases/0.26.1/abcl-src-0.26.1.zip (contents, props changed) public_html/releases/0.26.1/abcl-src-0.26.1.zip.asc Deleted: public_html/releases/0.26.0/ Added: public_html/releases/0.26.1/abcl-0.26.1.jar ============================================================================== Binary file. No diff available. Added: public_html/releases/0.26.1/abcl-0.26.1.jar.asc ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ public_html/releases/0.26.1/abcl-0.26.1.jar.asc Wed Jul 27 06:31:12 2011 (r13423) @@ -0,0 +1,7 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.9 (GNU/Linux) + +iEYEABECAAYFAk4wCpsACgkQi5O0Epaz9TmCOQCePRqAVygfYo/We8aYYTCNZ6Ko +jYMAmwbNJrrrqFx/ubyGqHUQmlHimJmQ +=a4Ko +-----END PGP SIGNATURE----- Added: public_html/releases/0.26.1/abcl-bin-0.26.1.tar.gz ============================================================================== Binary file. No diff available. Added: public_html/releases/0.26.1/abcl-bin-0.26.1.tar.gz.asc ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ public_html/releases/0.26.1/abcl-bin-0.26.1.tar.gz.asc Wed Jul 27 06:31:12 2011 (r13423) @@ -0,0 +1,7 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.9 (GNU/Linux) + +iEYEABECAAYFAk4wCp8ACgkQi5O0Epaz9TlMIwCfXLPW5UZgm4bcbOc6a9AFZqUU +SIkAnj/QCy/zEDJOnLO5hol9RWS0h3li +=Po9H +-----END PGP SIGNATURE----- Added: public_html/releases/0.26.1/abcl-bin-0.26.1.zip ============================================================================== Binary file. No diff available. Added: public_html/releases/0.26.1/abcl-bin-0.26.1.zip.asc ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ public_html/releases/0.26.1/abcl-bin-0.26.1.zip.asc Wed Jul 27 06:31:12 2011 (r13423) @@ -0,0 +1,7 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.9 (GNU/Linux) + +iEYEABECAAYFAk4wCqQACgkQi5O0Epaz9TkNfwCff0vZJuQGerSHYD7xr0RTeFMe +fnkAn3DD1RQmEq0aSVQhgll0DWBlK3QG +=jbye +-----END PGP SIGNATURE----- Added: public_html/releases/0.26.1/abcl-contrib-0.26.1.jar ============================================================================== Binary file. No diff available. Added: public_html/releases/0.26.1/abcl-contrib-0.26.1.jar.asc ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ public_html/releases/0.26.1/abcl-contrib-0.26.1.jar.asc Wed Jul 27 06:31:12 2011 (r13423) @@ -0,0 +1,7 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.9 (GNU/Linux) + +iEYEABECAAYFAk4wCqwACgkQi5O0Epaz9TklfwCdEAorimCDMSR+52ndawkT01eD +2P0An2QZjk0cbRrVH3QHrg4zc3e0DVHT +=gy/s +-----END PGP SIGNATURE----- Added: public_html/releases/0.26.1/abcl-src-0.26.1.tar.gz ============================================================================== Binary file. No diff available. Added: public_html/releases/0.26.1/abcl-src-0.26.1.tar.gz.asc ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ public_html/releases/0.26.1/abcl-src-0.26.1.tar.gz.asc Wed Jul 27 06:31:12 2011 (r13423) @@ -0,0 +1,7 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.9 (GNU/Linux) + +iEYEABECAAYFAk4wCrAACgkQi5O0Epaz9TkXggCfcoMeDt3ZV0R8Z/QIPaM86NKz +YnMAn1fYf2zhM4ILnv5CLL+qzxV/9ElM +=0hGw +-----END PGP SIGNATURE----- Added: public_html/releases/0.26.1/abcl-src-0.26.1.zip ============================================================================== Binary file. No diff available. Added: public_html/releases/0.26.1/abcl-src-0.26.1.zip.asc ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ public_html/releases/0.26.1/abcl-src-0.26.1.zip.asc Wed Jul 27 06:31:12 2011 (r13423) @@ -0,0 +1,7 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.9 (GNU/Linux) + +iEYEABECAAYFAk4wCrUACgkQi5O0Epaz9TlccwCcCHgr0Kn/d0SmMT9gg1GBUaq8 +/RkAn0BUa/7A9JU6tFfKTovTLNFxjwKv +=+xUa +-----END PGP SIGNATURE----- From ehuelsmann at common-lisp.net Wed Jul 27 14:00:57 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Wed, 27 Jul 2011 07:00:57 -0700 Subject: [armedbear-cvs] r13424 - public_html/releases/0.26.1 Message-ID: Author: ehuelsmann Date: Wed Jul 27 07:00:56 2011 New Revision: 13424 Log: Delete files uploaded in error. Deleted: public_html/releases/0.26.1/abcl-0.26.1.jar public_html/releases/0.26.1/abcl-0.26.1.jar.asc public_html/releases/0.26.1/abcl-contrib-0.26.1.jar public_html/releases/0.26.1/abcl-contrib-0.26.1.jar.asc From ehuelsmann at common-lisp.net Wed Jul 27 14:01:47 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Wed, 27 Jul 2011 07:01:47 -0700 Subject: [armedbear-cvs] r13425 - public_html Message-ID: Author: ehuelsmann Date: Wed Jul 27 07:01:45 2011 New Revision: 13425 Log: Add 0.26 release notes. Added: public_html/release-notes-0.26.shtml (contents, props changed) Added: public_html/release-notes-0.26.shtml ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ public_html/release-notes-0.26.shtml Wed Jul 27 07:01:45 2011 (r13425) @@ -0,0 +1,69 @@ + + + + + ABCL - Release notes v0.26 + + + + + +
+

ABCL - Release notes for version 0.26

+
+ + + +
+ +

Most notable changes in ABCL 0.26

+ + +

Release notes for older releases.

+ +
+
Support for weak references and hash tables +
+
In order to provide support for TRIVIAL-GARBAGE, we've implemented + support for weak lisp references and weak hash tables. +
+
Support for custom slot definition +
+
AMOP defines an interface to allow custom slot definitions. Support + for this interface has been added. +
+
Support for creating and loading ASDF systems into/from JARs +
+
The ASDF-JAR:PACKAGE function supports packaging of ASDF systems into + JARs while a simple REQUIRE will load it from there - once the directory + holding the jar has been added to ASDFs search path. +
+
Maven integration for ASDF +
+
ABCL implements a custom ASDF extension which allows loading Java + libraries from Maven repositories for better integration with the Java + world. +
+
Reduced number of ANSI test failures +
+
On my machine, ABCL now fails only 16 ANSI tests in interpreted mode, + while failing as few as 19 in compiled mode. That's a reduction of 10 + since 0.25. +
+
+ + + + +
+
+

Back to Common-lisp.net.

+ +
+ Valid XHTML 1.0 Strict +
+
$Id$
+
+ + From ehuelsmann at common-lisp.net Wed Jul 27 14:04:34 2011 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Wed, 27 Jul 2011 07:04:34 -0700 Subject: [armedbear-cvs] r13426 - public_html Message-ID: Author: ehuelsmann Date: Wed Jul 27 07:04:33 2011 New Revision: 13426 Log: Update links to new release. Modified: public_html/index.shtml public_html/left-menu Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml Wed Jul 27 07:01:45 2011 (r13425) +++ public_html/index.shtml Wed Jul 27 07:04:33 2011 (r13426) @@ -12,7 +12,7 @@ dd dt { font-weight: bold; font-style: italic } table.downloads { - color: black; + color: black; font-weight: bold; font-size: larger; } @@ -61,24 +61,24 @@ Binary - abcl-bin-0.25.0.tar.gz - (pgp) + abcl-bin-0.26.1.tar.gz + (pgp) - abcl-bin-0.25.0.zip - (pgp) + abcl-bin-0.26.1.zip + (pgp) Source - abcl-src-0.25.0.tar.gz - (pgp) + abcl-src-0.26.1.tar.gz + (pgp) - abcl-src-0.25.0.zip - (pgp) + abcl-src-0.26.1.zip + (pgp) Modified: public_html/left-menu ============================================================================== --- public_html/left-menu Wed Jul 27 07:01:45 2011 (r13425) +++ public_html/left-menu Wed Jul 27 07:04:33 2011 (r13426) @@ -1,7 +1,7 @@
Project page
Testimonials
-Release notes
+Release notes
Paid support
From mevenson at common-lisp.net Sun Jul 31 11:46:05 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Sun, 31 Jul 2011 04:46:05 -0700 Subject: [armedbear-cvs] r13427 - trunk/abcl/test/lisp/ansi Message-ID: Author: mevenson Date: Sun Jul 31 04:46:04 2011 New Revision: 13427 Log: Record ANSI test failures for r13415. Modified: trunk/abcl/test/lisp/ansi/ansi-test-failures Modified: trunk/abcl/test/lisp/ansi/ansi-test-failures ============================================================================== --- trunk/abcl/test/lisp/ansi/ansi-test-failures Wed Jul 27 07:04:33 2011 (r13426) +++ trunk/abcl/test/lisp/ansi/ansi-test-failures Sun Jul 31 04:46:04 2011 (r13427) @@ -404,22 +404,20 @@ PRINT.RANDOM-STATE.1 PPRINT-LOGICAL-BLOCK.17 FORMAT.C.2A FORMATTER.C.2A TRACE.8)) -(doit 0.27.0-dev-13414M :id saturn +(doit 0.27.0-dev-13415 :id saturn (DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 DEFGENERIC.30 - CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 DEFMETHOD.ERROR.14 - DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 MAKE-CONDITION.3 MAKE-CONDITION.4 - DELETE-PACKAGE.5 DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 - ENSURE-DIRECTORIES-EXIST.8 PRINT.RANDOM-STATE.1 - PPRINT-LOGICAL-BLOCK.17)) + CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 MAKE-CONDITION.3 + MAKE-CONDITION.4 DELETE-PACKAGE.5 DELETE-PACKAGE.6 MAP.48 + TYPE-OF.1 TYPE-OF.4 ENSURE-DIRECTORIES-EXIST.8 + PRINT.RANDOM-STATE.1 PPRINT-LOGICAL-BLOCK.17)) -(compileit 0.27.0-dev-13414M :id saturn - (ETYPECASE.15 MULTIPLE-VALUE-PROG1.10 DEFGENERIC.ERROR.20 - DEFGENERIC.ERROR.21 DEFGENERIC.30 CALL-NEXT-METHOD.ERROR.1 - CALL-NEXT-METHOD.ERROR.2 DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 - INVOKE-DEBUGGER.1 MAKE-CONDITION.3 MAKE-CONDITION.4 - DELETE-PACKAGE.5 DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 - ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.2 - PRINT.SYMBOL.RANDOM.3 PRINT.SYMBOL.RANDOM.4 +(compileit 0.27.0-dev-13415 :id saturn + (MULTIPLE-VALUE-PROG1.10 DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 + DEFGENERIC.30 CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 MAKE-CONDITION.3 + MAKE-CONDITION.4 DELETE-PACKAGE.5 DELETE-PACKAGE.6 MAP.48 + TYPE-OF.1 TYPE-OF.4 ENSURE-DIRECTORIES-EXIST.8 PRINT.RANDOM-STATE.1 PPRINT-LOGICAL-BLOCK.17 TRACE.8)) From mevenson at common-lisp.net Sun Jul 31 11:46:13 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Sun, 31 Jul 2011 04:46:13 -0700 Subject: [armedbear-cvs] r13428 - trunk/abcl Message-ID: Author: mevenson Date: Sun Jul 31 04:46:13 2011 New Revision: 13428 Log: Enable compilation with Java 7. Modified: trunk/abcl/build.xml Modified: trunk/abcl/build.xml ============================================================================== --- trunk/abcl/build.xml Sun Jul 31 04:46:04 2011 (r13427) +++ trunk/abcl/build.xml Sun Jul 31 04:46:13 2011 (r13428) @@ -174,6 +174,7 @@ From mevenson at common-lisp.net Sun Jul 31 13:01:44 2011 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Sun, 31 Jul 2011 06:01:44 -0700 Subject: [armedbear-cvs] r13429 - trunk/abcl/test/lisp/ansi Message-ID: Author: mevenson Date: Sun Jul 31 06:01:43 2011 New Revision: 13429 Log: Update tests results for Java7 (and abcl-0.26.1). Modified: trunk/abcl/test/lisp/ansi/ansi-test-failures Modified: trunk/abcl/test/lisp/ansi/ansi-test-failures ============================================================================== --- trunk/abcl/test/lisp/ansi/ansi-test-failures Sun Jul 31 04:46:13 2011 (r13428) +++ trunk/abcl/test/lisp/ansi/ansi-test-failures Sun Jul 31 06:01:43 2011 (r13429) @@ -389,20 +389,21 @@ (doit 0.26.1 :id saturn (DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 DEFGENERIC.30 CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 - DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 MAKE-CONDITION.3 - MAKE-CONDITION.4 DELETE-PACKAGE.5 DELETE-PACKAGE.6 MAP.48 - TYPE-OF.1 TYPE-OF.4 ENSURE-DIRECTORIES-EXIST.8 - PRINT.SYMBOL.RANDOM.2 PRINT.RANDOM-STATE.1 - PPRINT-LOGICAL-BLOCK.17 FORMAT.C.2A FORMATTER.C.2A)) + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 + MAKE-CONDITION.3 MAKE-CONDITION.4 DELETE-PACKAGE.5 + DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 + ENSURE-DIRECTORIES-EXIST.8 PRINT.STRING.RANDOM.1 + PRINT.RANDOM-STATE.1 PPRINT-LOGICAL-BLOCK.17)) -(compileit 0.26.1 :id saturn +(compileit 0.26.1 :id saturn (MULTIPLE-VALUE-PROG1.10 DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 DEFGENERIC.30 CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 - DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 MAKE-CONDITION.3 - MAKE-CONDITION.4 DELETE-PACKAGE.5 DELETE-PACKAGE.6 MAP.48 - TYPE-OF.1 TYPE-OF.4 ENSURE-DIRECTORIES-EXIST.8 - PRINT.RANDOM-STATE.1 PPRINT-LOGICAL-BLOCK.17 FORMAT.C.2A - FORMATTER.C.2A TRACE.8)) + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 + MAKE-CONDITION.3 MAKE-CONDITION.4 DELETE-PACKAGE.5 + DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 + ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.3 + PRINT.SYMBOL.RANDOM.4 PRINT.STRING.RANDOM.1 PRINT.RANDOM-STATE.1 + PPRINT-LOGICAL-BLOCK.17 TRACE.8)) (doit 0.27.0-dev-13415 :id saturn (DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 DEFGENERIC.30 @@ -420,7 +421,28 @@ TYPE-OF.1 TYPE-OF.4 ENSURE-DIRECTORIES-EXIST.8 PRINT.RANDOM-STATE.1 PPRINT-LOGICAL-BLOCK.17 TRACE.8)) +(doit 0.27.0-dev-r13420 :id saturn-java7 + (DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 DEFGENERIC.30 + CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 + MAKE-CONDITION.3 MAKE-CONDITION.4 DELETE-PACKAGE.5 + DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 + ENSURE-DIRECTORIES-EXIST.8 READ-BYTE.ERROR.5 WRITE-BYTE.ERROR.4 + CLEAR-INPUT.ERROR.5 FORCE-OUTPUT.ERROR.3 CLEAR-OUTPUT.ERROR.3 + PRINT.SYMBOL.RANDOM.2 PRINT.RANDOM-STATE.1 + PPRINT-LOGICAL-BLOCK.17)) +(compileit 0.27.0-dev-r13420 :id saturn-java7 + (MULTIPLE-VALUE-PROG1.10 DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 + DEFGENERIC.30 CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 + MAKE-CONDITION.3 MAKE-CONDITION.4 DELETE-PACKAGE.5 + DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 + ENSURE-DIRECTORIES-EXIST.8 READ-BYTE.ERROR.5 WRITE-BYTE.ERROR.4 + CLEAR-INPUT.ERROR.5 FORCE-OUTPUT.ERROR.3 CLEAR-OUTPUT.ERROR.3 + PRINT.SYMBOL.RANDOM.2 PRINT.SYMBOL.RANDOM.3 + PRINT.STRING.RANDOM.1 PRINT.RANDOM-STATE.1 + PPRINT-LOGICAL-BLOCK.17 TRACE.8))