Commit 5db533b0 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Test image-op. Add missing implementation method (oops).

parent b80f6659
......@@ -170,10 +170,11 @@ itself.")) ;; operation on a system and its dependencies
(bundle-output-files o c))
#-(or ecl mkcl)
(defmethod perform ((o program-op) (c system))
(let ((output-file (output-file o c)))
(setf *image-entry-point* (ensure-function (component-entry-point c)))
(dump-image output-file :executable t)))
(progn
(defmethod perform ((o image-op) (c system))
(dump-image (output-file o c) :executable (typep o 'program-op)))
(defmethod perform :before ((o program-op) (c system))
(setf *image-entry-point* (ensure-function (component-entry-point c)))))
(defclass compiled-file (file-component)
((type :initform #-(or ecl mkcl) (compile-file-type) #+(or ecl mkcl) "fasb")))
......
......@@ -2,7 +2,7 @@
#-mkcl
(defsystem :hello-world-example
:build-operation program-op
;; :build-operation program-op ; this would cause the executable output in same directory :-/
:entry-point "hello:entry-point"
:depends-on (:uiop)
:components ((:file "hello")))
......
......@@ -10,8 +10,20 @@
(asdf-test::frob-packages)
(with-test ()
;;(dolist (s '(:asdf :uiop :asdf/defsystem :uiop)) (DBG :foo s (asdf::builtin-system-p (find-system s))))
;;(trace perform-plan perform)
(dolist (s '(:asdf :uiop :asdf/defsystem :uiop))
(assert (asdf::builtin-system-p (find-system s)) () "System ~A not builtin(!)" s))
(defun make-hello-image ()
(operate 'load-fasl-op :hello-world-example)
(operate 'image-op :hello-world-example))
(defun make-hello-program ()
(operate 'load-fasl-op :hello-world-example)
(operate 'program-op :hello-world-example))
(operate 'program-op :hello-world-example)
#+(and mkcl windows) ;; make sure mkcl-X.X.X.dll is the same directory as the executable
(let* ((dll-orig (subpathname (si::self-truename)
(strcat "mkcl_" (lisp-implementation-version) ".dll")))
(exe (asdf::output-file 'program-op :hello-world-example))
(dll-dest (subpathname exe dll-orig)))
(copy-file dll-orig dll-dest)))
......@@ -144,7 +144,7 @@ do_tests () {
echo "Testing: $i" >&2
test_count=`expr "$test_count" + 1`
rm -f ~/.cache/common-lisp/"`pwd`"/* || true
if DO $bcmd $eval "'(#.(load(string'|script-support.lisp|))#.(asdf-test::load-asdf)#.(asdf-test::frob-packages)#.(asdf-test::with-test()(load(string'|$i|))))" ; then
if DO $bcmd $eval "'(#.(load(string'|script-support.lisp|))#.(asdf-test::load-asdf)#.(asdf-test::frob-packages)#.(asdf-test:run-test-script'|$i|))" ; then
echo "Using $command, $i passed" >&2
test_pass=`expr "$test_pass" + 1`
else
......@@ -476,10 +476,10 @@ test_clean_load () {
nop=build/results/${lisp}-nop.text
load=build/results/${lisp}-load.text
$bcmd $eval \
"(or'#.(load(string'|test/script-support.lisp|):verbose():print())#.(asdf-test::exit-lisp'0))" \
"(or'#.(load(string'|test/script-support.lisp|):verbose():print())#.(asdf-test:exit-lisp'0))" \
> $nop 2>&1
$bcmd $eval \
"(or'#.(load(string'|test/script-support.lisp|):verbose():print())#.(asdf-test::verbose())#.(load(string'|build/asdf.lisp|):verbose())#.(asdf/image:quit'0))" \
"(or'#.(load(string'|test/script-support.lisp|):verbose():print())#.(asdf-test:verbose())#.(load(string'|build/asdf.lisp|):verbose())#.(asdf/image:quit'0))" \
> $load 2>&1
if diff $nop $load ; then
echo "GOOD: Loading ASDF on $lisp produces no message" >&2 ; return 0
......@@ -492,13 +492,13 @@ test_load_systems () {
mkdir -p build/results/
echo "Loading all these systems: $*"
$bcmd $eval \
"(or #.(load(string'|test/script-support.lisp|))#.(asdf-test::with-test()(asdf-test::test-load-systems $*)))" \
"(or #.(load(string'|test/script-support.lisp|))#.(asdf-test:with-test()(asdf-test:test-load-systems $*)))" \
2>&1 | tee build/results/${lisp}-systems.text
}
test_interactively () {
cd ${ASDFDIR}
mkdir -p build/results/
rlwrap $icmd $eval "(or'#.(load(string'|test/script-support.lisp|))#.(asdf-test::interactive-test'($*)))"
rlwrap $icmd $eval "(or'#.(load(string'|test/script-support.lisp|))#.(asdf-test:interactive-test'($*)))"
}
if [ -z "$command" ] ; then
......
......@@ -24,6 +24,8 @@ Some constraints:
#:load-asdf-system #:clean-load-asdf-system
#:register-directory #:load-test-system
#:with-test #:test-asdf #:debug-asdf
#:run-test-script #:interactive-test
#:verbose #:exit-lisp
#:assert-compare
#:assert-equal
#:leave-test #:def-test-system
......@@ -357,6 +359,12 @@ is bound, write a message and exit on an error. If
(setf *package* (some 'find-package '(:asdf :uiop :asdf/utility :asdf/package :asdf-test)))
(load "contrib/debug.lisp"))
(defun run-test-script (file)
(with-test ()
(let ((name (string file)))
(format t "Running ~A with ~A~%" name (acall :implementation-identifier))
(load name))))
(defun load-asdf-lisp (&optional tag)
(quietly (load (asdf-lisp tag) :verbose *load-verbose* :print *load-print*)))
......
......@@ -49,35 +49,27 @@
(operate 'monolithic-fasl-op :test-asdf/bundle-2)
(assert (probe-file *mono-bundle-2*))
;;; Test dll-op and monolithic-dll-op on ECL.
#+ecl
(progn
(require 'sockets) ;; Test the pre-compiled system feature
(operate 'dll-op :test-asdf/dll-test)
(si:load-foreign-module (first (output-files 'dll-op :test-asdf/dll-test)))
(operate 'load-op :test-asdf/dll-user)
(assert-equal (test-package::sample-function) 42)
(operate 'monolithic-dll-op :test-asdf/monodll)
(si:load-foreign-module (first (output-files 'monolithic-dll-op :test-asdf/monodll)))
(operate 'load-op :test-asdf/monodll-user)
(assert-equal (test-package::always-42) 42))
;;; Test DLL-op and monolithic-dll-op on MKCL.
#+mkcl
;;; Test dll-op and monolithic-dll-op on ECL and MKCL
#+(or ecl mkcl)
(progn
(require 'sockets) ;; Test the pre-compiled system feature
(operate 'dll-op :test-asdf/dll-test)
(let ((dll (first (output-files 'dll-op :test-asdf/dll-test))))
(si:load-foreign-module dll)
(let* ( #+windows (compiler::*builder-default-libraries* (list (namestring dll))))
(let* (#+(and mkcl windows) (compiler::*builder-default-libraries* (list (namestring dll))))
(operate 'load-op :test-asdf/dll-user)))
(assert (= (test-package::sample-function) 42))
(let* #+windows ((lib (first (output-files (operate 'lib-op :test-asdf/monodll-1) :test-asdf/monodll-1)))
(compiler::*builder-default-libraries* (list (namestring lib))))
#-windows ()
(operate 'monolithic-dll-op :test-asdf/monodll))
(assert-equal (test-package::sample-function) 42)
(nest
#+(and mkcl windows)
(let* ((lib (first (output-files (operate 'lib-op :test-asdf/monodll-1) :test-asdf/monodll-1)))
(compiler::*builder-default-libraries* (list (namestring lib)))))
(operate 'monolithic-dll-op :test-asdf/monodll))
(let ((dll (first (output-files 'monolithic-dll-op :test-asdf/monodll))))
(si:load-foreign-module dll)
(let* ( #+windows (compiler::*builder-default-libraries* (list (namestring dll))))
(let* (#+(and mkcl windows) (compiler::*builder-default-libraries* (list (namestring dll))))
(operate 'load-op :test-asdf/monodll-user)))
(assert-equal (test-package::always-42) 42))
;;; TODO: test prebuilt-system.
......@@ -2,16 +2,11 @@
(DBG :foo (current-lisp-file-pathname))
(unless (or #+(or clisp clozure (and ecl (not ecl-bytecmp)) lispworks mkcl sbcl) t
#+cmu nil ;; uncomment if you have 32-bit gcc support - or can autodetect
#+clisp (version-satisfies
(first (split-string (lisp-implementation-version) :separator " "))
"2.48"))
(DBG "Creating standalone programs is not supported on your CL implementation")
(unless (or #+(or allegro clisp clozure cmu (and ecl (not ecl-bytecmp)) gcl lispworks mkcl sbcl scl) t)
(DBG "Creating images is not supported on your CL implementation")
(leave-test "Skipping test" 0))
(defparameter exe (output-file (make-operation 'program-op) (find-system :hello-world-example)))
(assert (absolute-pathname-p exe))
(assert (find-system :hello-world-example))
#-mkcl
(progn
......@@ -30,31 +25,64 @@
;; Disable any user source registry.
(initialize-source-registry `(:source-registry :ignore-inherited-configuration))
(delete-file-if-exists exe)
(trace run-program)
(DBG "test image-op")
(defparameter img (output-file (make-operation 'image-op) (find-system :hello-world-example)))
(assert (absolute-pathname-p img))
(delete-file-if-exists img)
(assert-equal
(nth-value 2
(run-program
(symbol-call :lisp-invocation :lisp-invocation-arglist
:load (native-namestring (subpathname *test-directory* "make-hello-world.lisp")))
:load (native-namestring (subpathname *test-directory* "make-hello-world.lisp"))
:eval "(asdf-test::make-hello-image)")
:output t :error-output :output :input nil))
0))
0)
(assert (probe-file* img) () "Can't find image file ~S" img)
#+mkcl
(progn
(operate 'program-op :hello-world-example)
#+windows
(let*
((dll-orig (merge-pathnames (make-pathname :name (mkcl:str+ "mkcl_" (lisp-implementation-version)) :type "dll")
(si::self-truename)))
(exe (car (asdf::output-files 'program-op :hello-world-example)))
(exe-dir (make-pathname :name nil :type nil :defaults exe))
(dll-dest (merge-pathnames exe-dir dll-orig)))
;; make sure mkcl-X.X.X.dll is the same directory as the executable
(copy-file dll-orig dll-dest)))
(assert-equal (run-program
(symbol-call :lisp-invocation :lisp-invocation-arglist
:image-path (native-namestring img)
:eval "(uiop:restore-image :entry-point 'hello:entry-point)")
:output :lines)
'("hello, world"))
(assert-equal (run-program
(symbol-call :lisp-invocation :lisp-invocation-arglist
:image-path (native-namestring img)
:eval "(uiop:restore-image :entry-point 'hello:entry-point)"
:arguments '("a" "b c" "d"))
:output :lines)
'("hello, world"
"You passed 3 arguments:"
" \"a\""
" \"b c\""
" \"d\""))
(DBG "test program-op")
(unless (or #+(or clisp clozure (and ecl (not ecl-bytecmp)) lispworks mkcl sbcl) t
#+cmu nil ;; uncomment if you have 32-bit gcc support - or can autodetect
#+clisp (version-satisfies
(first (split-string (lisp-implementation-version) :separator " "))
"2.48"))
(DBG "Creating standalone programs is not supported on your CL implementation")
(leave-test "Skipping test" 0))
(assert (probe-file* exe))
(defparameter exe (output-file (make-operation 'program-op) (find-system :hello-world-example)))
(assert (absolute-pathname-p exe))
(delete-file-if-exists exe)
(assert-equal
(nth-value 2
(run-program
(symbol-call :lisp-invocation :lisp-invocation-arglist
:load (native-namestring (subpathname *test-directory* "make-hello-world.lisp"))
:eval "(asdf-test::make-hello-program)")
:output t :error-output :output :input nil))
0)
(assert (probe-file* exe) () "Can't find executable file ~S" exe)
(assert-equal (run-program `(,(native-namestring exe)) :output :lines)
'("hello, world"))
......@@ -65,3 +93,5 @@
" \"a\""
" \"b c\""
" \"d\""))
;;; TODO: include a regular system dependency and a prebuilt-system in the executable.
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