Commit b27af7d2 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Fix the test so it runs at all.

parent f421e3f9
......@@ -44,6 +44,6 @@
`(,@(call-next-method)
,@(when (asdf::around-compile-hook comp)
`(:around-compile ,(escaped-around-compile-hook comp)))
`(:encoding ,(component-encoding comp))
,@(when (slot-boundp comp 'asdf/component::%encoding) `(:encoding ,(component-encoding comp)))
,@(slot-when-bound 'translated-name :translated-name)
,@(slot-when-bound 'translated-pathname :translated-pathname-form))))
......@@ -249,12 +249,11 @@ to the base of the system."
(setf system-names (append system-names (do-1-system system-name)))))))))
(defun read-component-file (pathname &rest system-names)
(let ((component-list nil))
(while-collecting (c)
(%comp-file-reader
pathname system-names
(lambda (system)
(setf component-list
(append component-list (getf (cdr system) :components)))))))
(map () #'c (getf (cdr system) :components))))))
(defun systems-in-configuration (pathname &rest system-names)
(let ((component-names nil))
......
......@@ -596,7 +596,7 @@
(t
(class-name (class-of component)))))
(defun normalize-pathname-directory-component (pathname-directory)
(defun normalize-pathname-directory-component* (pathname-directory)
(and pathname-directory
(loop
:with ups = nil
......@@ -616,7 +616,7 @@
(defun normalize-pathname-directory (pathname)
(make-pathname :directory
(normalize-pathname-directory-component (pathname-directory pathname))
(normalize-pathname-directory-component* (pathname-directory pathname))
:defaults pathname))
;; Currently used only by initially-grovel-dependencies.
......
#+xcvb (module ())
(cl:in-package :asdf)
(defpackage #:asdf-dependency-grovel
(:use #:cl #:asdf)
(defpackage :asdf-dependency-grovel
(:use :cl :asdf :uiop)
(:export #:reload
#:component-file
#:dependency-op
......@@ -23,8 +21,8 @@
#:fine-grain-instrumented-load
#:print-big-ol-dependency-report))
(defpackage #:asdf-dependency-grovel.packages
(defpackage :asdf-dependency-grovel.packages
(:use))
(defpackage #:asdf-dependency-grovel.lambdas
(defpackage :asdf-dependency-grovel.lambdas
(:use))
......@@ -8,6 +8,12 @@
(cl:in-package :asdf-dependency-grovel-tester)
(proclaim '(optimize (speed 1) (safety 2) (debug 3)))
(defparameter *adg-dir* (pathname-parent-directory-pathname *load-truename*))
(defparameter *adg-test-dir* (subpathname *adg-dir* "tests/"))
(chdir *adg-test-dir*)
(define-condition failed-component ()
((file :accessor failed-file :initarg :file)
......@@ -17,7 +23,8 @@
(defun canonicalize-name (name)
(subseq name (mismatch "u-" name) (position #\. name)))
(defun 1-component (all-comps &key file depends-on)
(defun 1-component (all-comps &key file depends-on (encoding nil encodingsp))
(declare (ignore encoding encodingsp))
(when (eql 2 (mismatch "u-" file))
(let* ((name (canonicalize-name file))
(provider-comp (format nil "p-~A" name))
......@@ -37,18 +44,14 @@
:file file :should dependency
:has depends-on)))))
(defparameter *adg-dir* (pathname-parent-directory-pathname *load-truename*))
(push *adg-dir* *central-registry*)
(push (subpathname *adg-dir* "tests/") *central-registry*)
;; (setf *break-on-signals* '(or error warning))
(load-system "asdf-dependency-grovel")
(defun test-result ()
(asdf:operate 'asdf-dependency-grovel:dependency-op :test-serial)
(let ((comps (asdf-dependency-grovel:read-component-file
"groveled-components.lisp" :test-serial-system))
(funcall *output-translation-function* (subpathname *adg-test-dir* "groveled-components.lisp"))
:test-serial-system))
(failed nil))
(loop for comp in comps
do (handler-case (apply #'1-component comps comp)
......
#!/bin/sh
LISP="${1:-openmcl}"
cd `dirname $0`
$LISP --load `pwd`/grovel-tests.lisp --eval '(ccl:quit (asdf-dependency-grovel-tester:test-result))'
STATUS=$?
rm -rf asdf-dependency-grovel-tmp-*
#$LISP --load `pwd`/grovel-tests.lisp --eval '(asdf-dependency-grovel-tester:check-base-deps)' --eval '(ccl:quit)'
rm -rf asdf-dependency-grovel-tmp-* groveled-components.lisp
exit $STATUS
#!/bin/sh
SBCL="${1:-sbcl}"
cd `dirname $0`
$SBCL --load `pwd`/grovel-tests.lisp --eval '(uiop:quit (asdf-dependency-grovel-tester:test-result))'
STATUS=$?
rm -rf asdf-dependency-grovel-tmp-*
#$SBCL --load `pwd`/grovel-tests.lisp --eval '(asdf-dependency-grovel-tester:check-base-deps)' --eval '(sb-ext:quit)'
#rm -rf asdf-dependency-grovel-tmp-* groveled-components.lisp
exit $STATUS
#!/bin/sh
## Works with either SBCL or CCL
LISP="${1:-sbcl}"
ADG_TEST_DIR="$(dirname $0)"
$LISP --load ${ADG_TEST_DIR}/grovel-tests.lisp --eval '(uiop:quit (asdf-dependency-grovel-tester:test-result))'
STATUS=$?
rm -rf asdf-dependency-grovel-tmp-*
#$LISP --load ${ADG_TEST_DIR}/grovel-tests.lisp --eval '(asdf-dependency-grovel-tester:check-base-deps)' --eval '(uiop:quit)'
#rm -rf asdf-dependency-grovel-tmp-* groveled-components.lisp
exit $STATUS
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