Commit 23d62d02 authored by Gary King's avatar Gary King
Browse files

CVS: ----------------------------------------------------------------------

	CVS: Enter Log.  Lines beginning with `CVS:' are removed automatically
Added *load-preference-files* variable (which defaults to nil). This
controls whether or not the ASDF preference file machinery gets run.
The rest of the preference machinery will be removed from ASDF
sometime in the future.

Also added several new test files.
parent 9ea17b5c
;;; This is asdf: Another System Definition Facility. $Revision: 1.116 $
;;; This is asdf: Another System Definition Facility. $Revision: 1.117 $
;;;
;;; Feedback, bug reports, and patches are all welcome: please mail to
;;; <cclan-list@lists.sf.net>. But note first that the canonical
......@@ -44,11 +44,11 @@
#:compile-op #:load-op #:load-source-op #:test-system-version
#:test-op
#:operation ; operations
#:feature ; sort-of operation
#:version ; metaphorically sort-of an operation
#:operation ; operations
#:feature ; sort-of operation
#:version ; metaphorically sort-of an operation
#:input-files #:output-files #:perform ; operation methods
#:input-files #:output-files #:perform ; operation methods
#:operation-done-p #:explain
#:component #:source-file
......@@ -85,7 +85,7 @@
#:operation-on-warnings
#:operation-on-failure
;#:*component-parent-pathname*
;#:*component-parent-pathname*
#:*system-definition-search-functions*
#:*central-registry* ; variables
#:*compile-file-warnings-behaviour*
......@@ -102,10 +102,11 @@
#:retry
#:accept ; restarts
#:preference-file-for-system/operation
#:load-preferences
)
)
;; preference loading - to be expunged
(:export
#:preference-file-for-system/operation
#:load-preferences)
(:use :cl))
......@@ -116,7 +117,7 @@
(in-package #:asdf)
(defvar *asdf-revision* (let* ((v "$Revision: 1.116 $")
(defvar *asdf-revision* (let* ((v "$Revision: 1.117 $")
(colon (or (position #\: v) -1))
(dot (position #\. v)))
(and v colon dot
......@@ -125,6 +126,11 @@
(parse-integer v :start (1+ dot)
:junk-allowed t)))))
(defvar *load-preference-files* nil
"If true, then preference files will be loaded.
This variable will be removed August 2008.")
(defvar *compile-file-warnings-behaviour* :warn)
(defvar *compile-file-failure-behaviour* #+sbcl :error #-sbcl :warn)
......@@ -766,7 +772,8 @@ the head of the tree"))
(defmethod perform :after ((operation operation) (c component))
(setf (gethash (type-of operation) (component-operation-times c))
(get-universal-time))
(load-preferences c operation))
(when *load-preference-files*
(load-preferences c operation)))
;;; perform is required to check output-files to find out where to put
;;; its answers, in case it has been overridden for site policy
......@@ -797,26 +804,6 @@ the head of the tree"))
#-:broken-fasl-loader (list (compile-file-pathname (component-pathname c)))
#+:broken-fasl-loader (list (component-pathname c)))
(defmethod perform :around ((o compile-op) (c cl-source-file))
(let ((state :initial))
(loop until (or (eq state :success)
(eq state :failure)) do
(case state
(:recompiled
(setf state :failure)
(call-next-method)
(setf state :success))
(:failed-compile
(setf state :recompiled)
(perform (make-instance 'asdf:compile-op) c))
(t
(with-simple-restart
(:try-recompiling "Try recompiling ~a"
(component-name c))
(setf state :failed-compile)
(call-next-method)
(setf state :success)))))))
(defmethod perform ((operation compile-op) (c static-file))
nil)
......@@ -928,13 +915,17 @@ the head of the tree"))
(defgeneric load-preferences (system operation)
(:documentation
"Called to load system preferences after <perform operation
"Deprecated - will be removed August 2008
Called to load system preferences after <perform operation
system>. Typical uses are to set parameters that don't exist until
after the system has been loaded."))
(defgeneric preference-file-for-system/operation (system operation)
(:documentation
"Returns the pathname of the preference file for this system.
"Deprecated - will be removed August 2008
Returns the pathname of the preference file for this system.
Called by 'load-preferences to determine what file to load."))
(defmethod load-preferences ((s t) (operation t))
......
......@@ -4,6 +4,7 @@
(exit-on-error
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(in-package :asdf)
(setf asdf::*load-preference-files* t)
(asdf:oos 'asdf:load-op 'test-preferences-system-1)
(assert (eq common-lisp-user::*test-preferences-variable-1* :load))
(asdf:oos 'asdf:test-op 'test-preferences-system-1)
......
(in-package #:common-lisp-user)
(setf *test6* :yes)
;;; -*- Lisp -*-
(asdf:defsystem test5
:components
((:module "deps"
:pathname "."
:components
((:file "file1")
(:file "file2" :load-only-p t)))))
;;; -*- Lisp -*-
(load "script-support")
(load "../asdf")
(exit-on-error
(asdf:run-shell-command "rm ~A ~A"
(namestring (compile-file-pathname "file1"))
(namestring (compile-file-pathname "file2")))
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:oos 'asdf:load-op 'test5)
(assert (probe-file (compile-file-pathname "file1")))
(assert (not (probe-file (compile-file-pathname "file2"))))
)
\ No newline at end of file
;;; -*- Lisp -*-
;; no preference loading by default
(load "script-support")
(load "../asdf")
(in-package #:common-lisp-user)
(defvar *test6* nil)
(exit-on-error
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(defmethod asdf:preference-file-for-system/operation
((system (eql (asdf:find-system 'test1))) operation)
(merge-pathnames (make-pathname :name "test1" :type "preferences")))
(asdf:operate 'asdf:load-op 'test1)
(assert (null *test6*)))
;;; -*- Lisp -*-
;; load preferences if asdf::*load-preference-files* is true
(load "script-support")
(load "../asdf")
(in-package #:common-lisp-user)
(defvar *test6* nil)
(exit-on-error
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(defmethod asdf:preference-file-for-system/operation
((system (eql (asdf:find-system 'test1))) operation)
(merge-pathnames (make-pathname :name "test1" :type "preferences")))
(setf asdf::*load-preference-files* t)
(asdf:operate 'asdf:load-op 'test1)
(assert (eq *test6* :yes)))
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