Changeset 14336


Ignore:
Timestamp:
12/18/12 21:59:12 (8 years ago)
Author:
Mark Evenson
Message:

backport r14335 | mevenson | 2012-12-18 22:54:37 +0100 (Tue, 18 Dec 2012) | 1 line

abcl-contrib: better logic for FIND-SYSTEM-JAR to deal with post patchlevel distinction.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/1.1.x/src/org/armedbear/lisp/abcl-contrib.lisp

    r14297 r14336  
    33(require :asdf)
    44
     5(defun system-jar-p (p)
     6  (and (pathnamep p)
     7       (equal (pathname-type p) "jar")
     8       (let ((name (pathname-name p)))
     9         (or
     10          (java:jstatic "matches"
     11                        "java.util.regex.Pattern"
     12                        "abcl(-[0-9]\\.[0-9]\\.[0-9]([+~-].+)?)?"
     13                        name)
     14          (java:jstatic "matches"
     15                        "java.util.regex.Pattern"
     16                        "abcl(-[0-9]\\.[0-9]\\.[0-9]\\.[0-9]([+~-]+)?)?"
     17                        name)))
     18       p))
     19
    520(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)))
     21  "Return the pathname of the system jar, one of `abcl.jar` or `abcl-m.n.p.jar` or `abcl-m.n.p[.~-]something.jar`."
    1522    (dolist (loader (java:dump-classpath))
    16       (let ((abcl-jar (some #'match-system-jar loader)))
     23      (let ((abcl-jar (some #'system-jar-p loader)))
    1724        (when abcl-jar
    18           (return abcl-jar))))))
     25          (return abcl-jar)))))
    1926
    2027(defvar *abcl-jar* nil
     
    2633Initialized via SYSTEM:FIND-CONTRIB")
    2734
    28 (defun find-contrib (&key (verbose nil))
     35(defun find-and-add-contrib (&key (verbose nil))
    2936  "Attempt to find the ABCL contrib jar and add its contents to ASDF.
    3037Returns 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
     38  (flet ((add-contrib (abcl-contrib)
    4239              (setf *abcl-contrib* abcl-contrib)
    4340              (dolist (asdf-file
     
    5047                    (push asdf-directory asdf:*central-registry*)
    5148                    (format verbose "~&Added ~A to ASDF.~&" asdf-directory))))
    52               *abcl-contrib*)
    53             (error "Failed to find abcl-contrib at '~A'." abcl-contrib))))))
     49              *abcl-contrib*))
     50    (unless *abcl-contrib*
     51      (unless *abcl-jar*
     52        (setf *abcl-jar* (find-system-jar)))
     53      (when *abcl-jar*
     54        (let* ((abcl-contrib-name
     55                (concatenate 'string "abcl-contrib"
     56                             (subseq (pathname-name *abcl-jar*) 4)))
     57               (abcl-contrib (make-pathname :defaults *abcl-jar*
     58                                            :name abcl-contrib-name)))
     59          (if (probe-file abcl-contrib)
     60              (add-contrib abcl-contrib)
     61              (let ((abcl-contrib  (make-pathname :defaults abcl-contrib
     62                                                  :name "abcl-contrib")))
     63                (if (probe-file abcl-contrib)
     64                    (progn 
     65                      (warn "Falling back to using '~A' to satisfy require." abcl-contrib)
     66                      (add-contrib abcl-contrib)
     67                      (error "Failed to find abcl-contrib at '~A'." abcl-contrib))))))))))
    5468
    55 (when (find-contrib :verbose t)
     69(when (find-and-add-contrib :verbose t)
    5670  (provide :abcl-contrib))
    5771
Note: See TracChangeset for help on using the changeset viewer.