Commit 1cf58c2f authored by Nikodemus Siivola's avatar Nikodemus Siivola
Browse files

OOS :VERSION support. Thanks to Robert P. Goldman.

parent 0c14c8d0
;;; This is asdf: Another System Definition Facility. $Revision: 1.96 $
;;; This is asdf: Another System Definition Facility. $Revision: 1.97 $
;;;
;;; Feedback, bug reports, and patches are all welcome: please mail to
;;; <cclan-list@lists.sf.net>. But note first that the canonical
......@@ -109,7 +109,7 @@
(in-package #:asdf)
(defvar *asdf-revision* (let* ((v "$Revision: 1.96 $")
(defvar *asdf-revision* (let* ((v "$Revision: 1.97 $")
(colon (or (position #\: v) -1))
(dot (position #\. v)))
(and v colon dot
......@@ -828,37 +828,37 @@ system."))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; invoking operations
(defun operate (operation-class system &rest args)
(defun operate (operation-class system &rest args &key (verbose t) version)
(let* ((op (apply #'make-instance operation-class
:original-initargs args args))
(*verbose-out*
(if (getf args :verbose t)
*trace-output*
(make-broadcast-stream)))
(system (if (typep system 'component) system (find-system system)))
(steps (traverse op system)))
(with-compilation-unit ()
(loop for (op . component) in steps do
(loop
(restart-case
(progn (perform op component)
(return))
(retry ()
:report
(lambda (s)
(format s "~@<Retry performing ~S on ~S.~@:>"
op component)))
(accept ()
:report
(lambda (s)
(format s
"~@<Continue, treating ~S on ~S as ~
having been successful.~@:>"
op component))
(setf (gethash (type-of op)
(component-operation-times component))
(get-universal-time))
(return))))))))
:original-initargs args
args))
(*verbose-out* (if verbose *trace-output* (make-broadcast-stream)))
(system (if (typep system 'component) system (find-system system))))
(unless (version-satisfies system version)
(error 'missing-component :requires system :version version))
(let ((steps (traverse op system)))
(with-compilation-unit ()
(loop for (op . component) in steps do
(loop
(restart-case
(progn (perform op component)
(return))
(retry ()
:report
(lambda (s)
(format s "~@<Retry performing ~S on ~S.~@:>"
op component)))
(accept ()
:report
(lambda (s)
(format s
"~@<Continue, treating ~S on ~S as ~
having been successful.~@:>"
op component))
(setf (gethash (type-of op)
(component-operation-times component))
(get-universal-time))
(return)))))))))
(defun oos (&rest args)
"Alias of OPERATE function"
......
;; -*- lisp -*-
(load "../asdf")
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(defpackage :test-version-system
(:use :cl :asdf))
(in-package :test-version-system)
(defsystem :versioned-system-1
:pathname #.*default-pathname-defaults*
:version "1.0")
(defsystem :versioned-system-2
:pathname #.*default-pathname-defaults*
:version "1.1")
(defsystem :versioned-system-3
:pathname #.*default-pathname-defaults*
:version "1.2")
(flet ((test (name v &optional (true t))
(or (eq true (asdf::version-satisfies (find-system name) v))
(error "no satisfaction: ~S version ~A not ~A" name v true))))
(test :versioned-system-1 "1.0")
(test :versioned-system-2 "1.0")
(test :versioned-system-3 "2.0" nil))
\ No newline at end of file
;;; -*- Lisp -*-
(asdf:defsystem wild-module
(asdf:defsystem :wild-module
:version "0.0"
:components ((:wild-module "systems"
:pathname "*.asd")))
:components ((:wild-module "systems" :pathname "*.asd")))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment