Commit 0e0a851b authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Fix bundle-op and concatenate-source-op file order

Fix direct-dependencies, that was reversed from file order,
leading to inversions in the order of input files for bundle-op and
concatenate-source-op as compared to what a user would expect.

Check all the bootstrap file lists and provide an *actionable* error message
when discrepancies are detected.

Also fix bundle's use of required-components to be in line with an old comment.
And remove the comment.
parent 9395f43a
......@@ -90,10 +90,7 @@ itself."))
(deps
(required-components
s :other-systems mono :component-type (if mono 'system '(not system))
:goal-operation (find-operation o 'load-op)
:keep-operation 'compile-op)))
;; NB: the explicit make-operation on ECL and MKCL
;; ensures that we drop the original-initargs and its magic flags when recursing.
:goal-operation 'load-op :keep-operation 'load-op)))
`((,(or (gather-operation o) (if mono 'lib-op 'compile-op)) ,@deps)
,@(call-next-method))))
......
......@@ -64,7 +64,7 @@ into a single file"))
:with other-around-compile = '()
:for c :in (required-components
s :goal-operation 'load-op
:keep-operation 'compile-op
:keep-operation 'load-op
:other-systems (operation-monolithic-p operation))
:append
(when (typep c 'cl-source-file)
......
......@@ -222,7 +222,7 @@ initialized with SEED."
(defun* (direct-dependencies) (plan operation component)
"Compute a list of the direct dependencies of the action within the plan"
(reduce-direct-dependencies plan operation component #'acons nil))
(reverse (reduce-direct-dependencies plan operation component #'acons nil)))
;; In a distant future, get-file-stamp, component-operation-time and latest-stamp
;; shall also be parametrized by the plan, or by a second model object,
......
......@@ -98,30 +98,38 @@
;;; disabling this test on windows since it relies on running make-asdf.bat, which
;;; does not work for me under cygwin. - rpg 2016-03-20
(defun search-makefile (target)
(with-open-file (str (merge-pathnames (make-pathname :name "Makefile" :type nil)
*asdf-directory* ))
(let ((line
(loop for x = (read-line str)
when (search target x)
return (subseq x (length target))
finally (error "Didn't find ~a in Makefile." target))))
(mapcar 'parse-native-namestring (split-string line)))))
(defun bootstrap-lisp-files (file line-prefix)
(with-input-file (input (subpathname *asdf-directory* file))
(loop :for line = (read-line input)
:when (string-prefix-p line-prefix line)
:return (subseq line (length line-prefix))
:finally (error "Didn't find ~a in ~a" line-prefix file))))
(DBG "Checking that the bootstrap script and asdf.asd are in synch")
(defun system-lisp-files (system)
(loop :for f :in (input-files 'concatenate-source-op system)
:collect (enough-pathname f *asdf-directory*)))
(defun bootstrap-lisp-files (target)
(let ((target (format nil "~a := " target)))
(search-makefile target)))
(defmacro compare-files (system target)
`(assert-pathnames-equal (system-lisp-files ,system) (bootstrap-lisp-files ,target)))
(DBG "Testing that the Makefile and ASDF agree on the order of UIOP files")
(compare-files :uiop "driver_lisp")
(DBG "Testing that the Makefile and ASDF agree on the order of ASDF/DEFSYSTEM files")
(compare-files :asdf/defsystem "defsystem_lisp")
(loop
:with errors = ()
:for (file prefix-fmt value-fmt backslash) :in
'(("Makefile" "~A := " "~{~A~^ ~}")
("make-asdf.sh" "~A=" "\"~{~A~^ ~}\"")
("make-asdf.bat" "set ~A=" "~{~A~^ + ~}" t)) :do
(format t "~%Expecting to find in ~A the following lines:~%" file)
(loop
:for (system variable-name) :in
'((:uiop "driver_lisp")
(:asdf/defsystem "defsystem_lisp"))
:for files = (system-lisp-files system)
:for prefix = (format nil prefix-fmt variable-name)
:for expected0 = (format nil value-fmt files)
:for expected = (if backslash (substitute #\\ #\/ expected0) expected0)
:for found = (bootstrap-lisp-files file prefix)
:do (format t "~A~A~%" prefix expected)
:unless (equal expected found)
:do (push (format nil "In ~A expected:~%~A~A~%~%but found:~%~A~A~%~%~%"
file prefix expected prefix found)
errors))
:finally (when errors (error (reduce/strcat (reverse errors)))))
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