- bug fix: when --non-shared-only is specified, only check if the

non-shared part of the package is already present to decide whether
  to install the package or not (reported by Eric Knauel),
- fail with an error if --phases is used but the package requires a
  version older than 1.2.0 of install-lib.

scheme/install-lib/install-lib.scm

@@ -1,5 +1,5 @@
 ;;; Installation library for scsh modules.
-;;; $Id: install-lib.scm,v 1.23 2004/11/08 19:56:28 michel-schinz Exp $
+;;; $Id: install-lib.scm,v 1.24 2004/11/13 20:14:57 michel-schinz Exp $
 
 ;; TODO
 ;; - think about --build: does it make sense?
@@ -486,6 +486,10 @@
     ((define-program name version extensions body ...)
      (define-package name version extensions body ...))))
 
+(define (package-version-requirement pkg)
+  (and-let* ((req-lst (package-extension pkg 'install-lib-version)))
+            (first req-lst)))
+
 ;; Load (and evaluate the contents of) the file "pkg-def.scm" in the
 ;; current directory and return the packages it defines.
 (define (load-packages)
@@ -498,8 +502,7 @@
 ;; Check that the given package does not require a more recent version
 ;; of the installation library, and fail if it is the case.
 (define (check-package pkg)
-  (and-let* ((req-lst (package-extension pkg 'install-lib-version))
-             (req (first req-lst))
+  (and-let* ((req (package-version-requirement pkg))
              ((or (not (= (version-major req)
                           (version-major install-lib-version)))
                   (> (version-minor req)
@@ -751,7 +754,6 @@
          (dest-dir (alist-get 'dest-dir options-values))
          (dest-prefix (and prefix (string-append dest-dir prefix)))
          (layout-fn (resolve-layout (alist-get 'layout options-values)))
-         (build (alist-get 'build options-values))
          (activate? (not (alist-get 'inactive options-values))))
     (let-fluids *options-values* options-values
       (lambda ()
@@ -784,8 +786,7 @@
 ;; Error handling
 ;;
 
-;; Display all the MSGS on the error port, then exit with an error
-;; code of 1.
+;; Display all the MSGS, then exit with an error code of 1.
 (define (display-error-and-exit . msgs)
   (for-each display (cons "Error: " msgs))
   (newline)
@@ -1055,11 +1056,14 @@
 ;; Partition PACKAGES in two sets: the ones which are not installed
 ;; yet, and the ones which are already. If FORCE? is true, pretend
 ;; that all packages are not installed yet.
-(define (partition-packages prefix layout packages force?)
+(define (partition-packages prefix layout packages force? non-shared-only?)
   (partition (lambda (pkg)
                (or force?
-                   (file-not-exists?
-                    (layout-dir (absolute-layout (layout pkg) prefix) 'base))))
+                   (let ((abs-layout (absolute-layout (layout pkg) prefix)))
+                     (file-not-exists?
+                      (if non-shared-only?
+                          (paths->file-name (layout-dir abs-layout 'lib) (host))
+                          (layout-dir abs-layout 'base))))))
              packages))
 
 (define (install-main-internal cmd-line display-hint?)
@@ -1082,7 +1086,8 @@
            (phases (alist-get 'phases options-values))
            (prefix (alist-get 'prefix options-values))
            (layout (alist-get 'layout options-values))
-           (force? (alist-get 'force options-values)))
+           (force? (alist-get 'force options-values))
+           (non-shared-only? (alist-get 'non-shared-only options-values)))
       (if (null? packages)
           (display-error-and-exit
            "no package to install"
@@ -1098,8 +1103,18 @@
       (let ((resolved-layout (resolve-layout layout)))
         (if (not resolved-layout)
             (display-error-and-exit "invalid layout "layout))
+        (if (and (not (lset= eq? phases all-phases))
+                 (any (lambda (req) (version<? req '(1 2 0)))
+                      (filter-map package-version-requirement packages)))
+            (display-error-and-exit
+             "at least one of the packages about to be installed might not\n"
+             "understand the --phases option. Re-run without using --phases."))
         (receive (pkgs-install pkgs-skip)
-                 (partition-packages prefix resolved-layout packages force?)
+                 (partition-packages prefix
+                                     resolved-layout
+                                     packages
+                                     force?
+                                     non-shared-only?)
                  (install-packages pkgs-install options-values)
                  (if (and display-hint? (member 'install phases))
                      (display-use-hint prefix