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

[Ville Voutilainen]

Author: vvoutilainen
Date: Fri Jan  2 17:28:10 2009
New Revision: 11524

Log:
Tiny helper for checking that class file is loadable.


Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Fri Jan  2 17:28:10 2009
@@ -4774,7 +4774,11 @@
 	  (progn , at body)
        (delete-file pathname))))
 
-
+(defun verify-class-file-loadable (pathname)
+  (let ((*load-truename* (pathname pathname)))
+    (unless (ignore-errors (load-compiled-function pathname))
+      (error "Unable to load ~S." pathname))))
+  
 (defknown p2-flet-process-compiland (t) t)
 (defun p2-flet-process-compiland (local-function)
   (let* ((compiland (local-function-compiland local-function))
@@ -4784,12 +4788,8 @@
                   (class-file (make-class-file :pathname pathname
                                                :lambda-list lambda-list)))
 	     (set-compiland-and-write-class-file class-file compiland)
-             ;; Verify that the class file is loadable.
-             (let ((*load-truename* (pathname pathname)))
-               (unless (ignore-errors (load-compiled-function pathname))
-                 (error "Unable to load ~S." pathname)))
+	     (verify-class-file-loadable pathname)
              (setf (local-function-class-file local-function) class-file))
-
            (when (local-function-variable local-function)
              (let ((g (declare-local-function local-function)))
 	       (emit-make-compiled-closure-for-flet/labels 
@@ -4814,10 +4814,7 @@
                   (class-file (make-class-file :pathname pathname
                                                :lambda-list lambda-list)))
 	     (set-compiland-and-write-class-file class-file compiland)
-             ;; Verify that the class file is loadable.
-             (let ((*load-truename* (pathname pathname)))
-               (unless (ignore-errors (load-compiled-function pathname))
-                 (error "Unable to load ~S." pathname)))
+	     (verify-class-file-loadable pathname)
              (setf (local-function-class-file local-function) class-file)
              (let ((g (declare-local-function local-function)))
 	       (emit-make-compiled-closure-for-flet/labels