From 1cf58c2fdfe43333ff58ccc6f058be56cfe04dcd Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola <nikodemus@random-state.net> Date: Sun, 14 May 2006 16:03:16 +0000 Subject: [PATCH] OOS :VERSION support. Thanks to Robert P. Goldman. --- asdf.lisp | 64 ++++++++++++++++++++-------------------- test/test-version.script | 30 +++++++++++++++++++ test/wild-module.asd | 5 ++-- 3 files changed, 64 insertions(+), 35 deletions(-) create mode 100644 test/test-version.script diff --git a/asdf.lisp b/asdf.lisp index 1a38b2d6..7143e660 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -1,4 +1,4 @@ -;;; 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" diff --git a/test/test-version.script b/test/test-version.script new file mode 100644 index 00000000..16465ca3 --- /dev/null +++ b/test/test-version.script @@ -0,0 +1,30 @@ +;; -*- 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 diff --git a/test/wild-module.asd b/test/wild-module.asd index 8c090084..b12f351c 100644 --- a/test/wild-module.asd +++ b/test/wild-module.asd @@ -1,6 +1,5 @@ ;;; -*- Lisp -*- -(asdf:defsystem wild-module +(asdf:defsystem :wild-module :version "0.0" - :components ((:wild-module "systems" - :pathname "*.asd"))) + :components ((:wild-module "systems" :pathname "*.asd"))) -- GitLab