[armedbear-cvs] r13193 - trunk/abcl/src/org/armedbear/lisp

Erik Huelsmann ehuelsmann at common-lisp.net
Sun Jan 30 18:55:49 UTC 2011


Author: ehuelsmann
Date: Sun Jan 30 13:55:48 2011
New Revision: 13193

Log:
Revert r13190: Detect loops in autoloads and requires.

Note: This commit broke trunk; reverting restores it.

Modified:
   trunk/abcl/src/org/armedbear/lisp/Autoload.java
   trunk/abcl/src/org/armedbear/lisp/require.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/Autoload.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Autoload.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Autoload.java	Sun Jan 30 13:55:48 2011
@@ -45,12 +45,6 @@
 
     private final Symbol symbol;
 
-    private final static Symbol AUTOLOADS_IN_PROGRESS
-            = PACKAGE_SYS.addInternalSymbol("*AUTOLOADS-IN-PROGRESS*");
-    {
-        AUTOLOADS_IN_PROGRESS.setSymbolValue(NIL);
-    }
-
     protected Autoload(Symbol symbol)
     {
         super();
@@ -139,34 +133,12 @@
         out._finishOutput();
     }
 
-    private void detectCircularity(LispThread thread) {
-        SimpleString val = new SimpleString((getFileName() == null)
-                ? className : getFileName());
-        LispObject autoloads = AUTOLOADS_IN_PROGRESS.symbolValue(thread);
-        LispObject list = autoloads;
-        while (list != NIL) {
-            if (val.equal(list.car()))
-                Lisp.error(new SimpleString("Autoloading circularity detected while resolving "
-                        + symbol.getQualifiedName() + "; autoloads in "
-                        + "progress: " + autoloads.writeToString()));
-
-            list = list.cdr();
-        }
-
-        return;
-    }
-
     public void load()
     {
         final LispThread thread = LispThread.currentThread();
-
-        detectCircularity(thread);
-
         final SpecialBindingsMark mark = thread.markSpecialBindings();
         int loadDepth = Fixnum.getValue(_LOAD_DEPTH_.symbolValue());
         thread.bindSpecial(_LOAD_DEPTH_, Fixnum.getInstance(++loadDepth));
-        thread.pushSpecial(AUTOLOADS_IN_PROGRESS,
-                new SimpleString((getFileName() == null) ? className : getFileName()));
         try {
             if (_AUTOLOAD_VERBOSE_.symbolValue(thread) != NIL
                 || "Y".equals(System.getProperty("abcl.autoload.verbose")))

Modified: trunk/abcl/src/org/armedbear/lisp/require.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/require.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/require.lisp	Sun Jan 30 13:55:48 2011
@@ -36,30 +36,23 @@
   (pushnew (string module-name) *modules* :test #'string=)
   t)
 
-(defun module-provide-system (module)
+(defun module-provide-system (module) 
   (let ((*readtable* (copy-readtable nil)))
-    (handler-case
+    (handler-case 
         (load-system-file (string-downcase (string module)))
-      (t (e)
+      (t (e) 
         (unless (and (typep e 'error)
                      (search "Failed to find loadable system file"
                              (format nil "~A" e)))
-          (format *error-output* "Failed to require  ~A because '~A'~%"
+          (format *error-output* "Failed to require  ~A because '~A'~%" 
                   module e))
         nil))))
-
+    
 (defvar *module-provider-functions* nil)
-(defvar *requires-in-progress* nil)
 
 (defun require (module-name &optional pathnames)
   (unless (member (string module-name) *modules* :test #'string=)
-    (unless (member (string module-name) *requires-in-progress*
-                    :test #'string=)
-      (error "Circularity detected while requiring ~A; ~
-              nesting list: ~S." module-name *requires-in-progress*))
-    (let ((saved-modules (copy-list *modules*))
-          (*requires-in-progress* (cons (string module-name)
-                                        *requires-in-progress*)))
+    (let ((saved-modules (copy-list *modules*)))
       (cond (pathnames
              (unless (listp pathnames) (setf pathnames (list pathnames)))
              (dolist (x pathnames)




More information about the armedbear-cvs mailing list