source: branches/1.1.x/src/org/armedbear/lisp/abcl-contrib.lisp @ 14297

Last change on this file since 14297 was 14297, checked in by Mark Evenson, 8 years ago

Backport r14296.

Constrain the logic for when CL:REQUIRE pushes symbols to CL:*MODULES*.

A REQUIRE of ABCL-CONTRIB for an instance of the implementation that
cannot locate the contrib binary artifact as being in the same
directory as the location of the ABCL system jar by
SYS:FIND-SYSTEM-JAR now raises an error.

Fixes #275.

File size: 2.3 KB
Line 
1(in-package :system)
2
3(require :asdf)
4
5(defun find-system-jar () 
6  "Return the pathname of the system jar, one of `abcl.jar` or `abcl-m.n.p.jar` or `abcl-m.n.p-something.jar`."
7  (flet ((match-system-jar (p)
8           (and (pathnamep p)
9                (equal (pathname-type p) "jar")
10                (java:jstatic "matches"
11                              "java.util.regex.Pattern" 
12                              "abcl(-[0-9]\\.[0-9]\\.[0-9]([+~-].+)?)?" 
13                              (pathname-name p))
14                p)))
15    (dolist (loader (java:dump-classpath))
16      (let ((abcl-jar (some #'match-system-jar loader)))
17        (when abcl-jar
18          (return abcl-jar))))))
19
20(defvar *abcl-jar* nil
21  "Pathname of the jar that ABCL was loaded from.
22Initialized via SYSTEM::FIND-SYSTEM-JAR.")
23
24(defvar *abcl-contrib* nil
25  "Pathname of the ABCL contrib.
26Initialized via SYSTEM:FIND-CONTRIB")
27
28(defun find-contrib (&key (verbose nil))
29  "Attempt to find the ABCL contrib jar and add its contents to ASDF.
30Returns the pathname of the contrib if it can be found."
31  (unless *abcl-contrib*
32    (unless *abcl-jar*
33      (setf *abcl-jar* (find-system-jar)))
34    (when *abcl-jar*
35      (let* ((abcl-contrib-name
36              (concatenate 'string "abcl-contrib"
37                           (subseq (pathname-name *abcl-jar*) 4)))
38             (abcl-contrib (make-pathname :defaults *abcl-jar*
39                                          :name abcl-contrib-name)))
40  (if (probe-file abcl-contrib)
41            (progn
42              (setf *abcl-contrib* abcl-contrib)
43              (dolist (asdf-file
44                        (directory (make-pathname :device (list *abcl-contrib*)
45                                                  :directory '(:absolute :wild)
46                                                  :name :wild
47                                                  :type "asd")))
48                (let ((asdf-directory (make-pathname :defaults asdf-file :name nil :type nil)))
49                  (unless (find asdf-directory asdf:*central-registry* :test #'equal)
50                    (push asdf-directory asdf:*central-registry*)
51                    (format verbose "~&Added ~A to ASDF.~&" asdf-directory))))
52              *abcl-contrib*)
53            (error "Failed to find abcl-contrib at '~A'." abcl-contrib))))))
54
55(when (find-contrib :verbose t)
56  (provide :abcl-contrib))
57
58
59
60
61
62
63
64       
65 
Note: See TracBrowser for help on using the repository browser.