;;; -*- Lisp -*- (DBG :foo (current-lisp-file-pathname)) (unless (or #+(or allegro (and clisp os-unix) clozure cmucl (and ecl (not ecl-bytecmp)) lispworks mkcl sbcl scl) t) (DBG "Creating images is not supported on your CL implementation") (leave-test "Skipping test" 0)) #+(and sbcl openbsd) (let ((version (run-program "uname -r" :output '(:string :stripped t)))) (when (version-satisfies version "6.0") (DBG "Running on OpenBSD >=6.0. Checking this partition for wxallowed.") (let* ((df-line (second (uiop:run-program (list "df" "-P" (native-namestring *build-directory*)) :output :lines))) (device (first (split-string df-line)))) (dolist (mount-line (uiop:run-program "mount" :output :lines)) (let ((mount-device (first (split-string mount-line)))) (when (and (string= device mount-device) (not (search "wxallowed" mount-line))) (leave-test "Skipping test: wxallowed not set" 0))))))) (assert (find-system :hello-world-example)) ;; Try to load lisp-invocation from xcvb (initialize-source-registry `(:source-registry (:directory ,*asdf-directory*) (:directory (,*asdf-directory* "uiop/")) (:tree (,*asdf-directory* "ext/")) :inherit-configuration)) (unless (find-system :lisp-invocation nil) (leave-test "Couldn't find lisp-invocation. Probably your ASDF ext/ directory needs submodule update." 1)) (unless (version-satisfies (find-system "lisp-invocation") "1.0.12") (leave-test "Lisp-invocation library isn't new enough to test successfully. Probably your ASDF ext/ directory needs submodule update." 1)) (load-system "lisp-invocation/all") ;; Disable any user source registry. (initialize-source-registry `(:source-registry :ignore-inherited-configuration)) (defun make-hello-world (kind) (assert-equal 0 (nth-value 2 (lisp-invocation:invoke-lisp :implementation-type (lisp-invocation/allegro-variants:current-lisp-variant) :cross-compile nil :load (native-namestring (subpathname *test-directory* "make-hello-world.lisp")) :eval (format nil "(asdf-test::make-hello-~(~a~))" kind) :run-program-args `(:input nil :ignore-error-status t :output (,*standard-output* :linewise t :prefix "stdout: ") :error-output (,*error-output* :linewise t :prefix "stderr: ")))))) (progn (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) (DBG "- first create an executable image") (make-hello-world 'image) #+cmucl (unless (probe-file* img) (leave-test "CMUCL seemingly can't find the 32-bit compiler and libraries required to dump images. Aborting test." 0)) (assert (probe-file* img) () "Can't find image file ~S" img) (DBG "- then use this executable image") (assert-equal (nest #+lispworks (last) (lisp-invocation:invoke-lisp :implementation-type (lisp-invocation/allegro-variants:current-lisp-variant) :cross-compile nil :image-path (native-namestring img) :eval "(uiop:restore-image :entry-point 'hello:entry-point :lisp-interaction nil)" :run-program-args '(:output :lines :error-output t))) '("hello, world")) (DBG "- now, use this executable image with arguments") #-(or lispworks scl) ;; These can't be passed arguments the normal way (assert-equal (lisp-invocation:invoke-lisp :implementation-type (lisp-invocation/allegro-variants:current-lisp-variant) :image-path (native-namestring img) :cross-compile nil :eval "(uiop:restore-image :entry-point 'hello:entry-point :lisp-interaction nil)" :arguments '("a" "b c" "d") :run-program-args '(:output :lines :error-output t)) '("hello, world" "You passed 3 arguments:" " \"a\"" " \"b c\"" " \"d\""))) (progn (DBG "test program-op") (unless (or #+(or clisp clozure (and ecl (not ecl-bytecmp)) lispworks mkcl sbcl) t #+cmucl 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)) (defparameter exe (output-file (make-operation 'program-op) (find-system :hello-world-example))) (assert (absolute-pathname-p exe)) (delete-file-if-exists exe) (DBG "- first, create the standalone program") (make-hello-world 'program) (assert (probe-file* exe) () "Can't find executable file ~S" exe) (DBG "- use that standalone program") (assert-equal (run-program `(,(native-namestring exe)) :output :lines :error-output t) '("hello, world")) (DBG "- use that standalone program with arguments") (assert-equal (run-program `(,(native-namestring exe) "a" "b c" "d") :output :lines :error-output t) '("hello, world" "You passed 3 arguments:" " \"a\"" " \"b c\"" " \"d\""))) #+(or ecl mkcl) (progn (DBG "Now create an program without UIOP") (assert (probe-file (asdf/bundle::system-module-pathname "asdf"))) (assert (probe-file (asdf/bundle::system-module-pathname "cmp"))) (def-test-system hello-no-uiop :class program-system :no-uiop t :components ((:file "file1")) :epilogue-code (progn (format t "~:[Look ma, no UIOP~;Oops, UIOP~]!~%" (find-package :uiop)) (format t "~:[But no TEST-PACKAGE :-(~;And TEST-PACKAGE~]!~%" (find-package :test-package)) (format t "~:[And no ASDF~;But ASDF :-( ~]!~%" (find-package :asdf)) #+ecl (si:quit 0) #+mkcl (mk-ext:quit :exit-code 0))) (operate 'program-op 'hello-no-uiop :force t) (DBG :run (output-file 'program-op 'hello-no-uiop)) (assert-equal (run-program `(,(native-namestring (output-file 'program-op 'hello-no-uiop))) :output :lines :error-output t) '("Look ma, no UIOP!" "And TEST-PACKAGE!" "And no ASDF!")) (DBG "Now create an program with explicit ASDF dependency, without registered ASDF (use implementation-provided prebuilt)") (trace c::builder) ;; component-depends-on input-files output-files (assert-pathname-equal (truename (pathname-directory-pathname (output-file 'lib-op (asdf/bundle::linkable-system "asdf")))) (truename (lisp-implementation-directory))) (def-test-system hello-asdf :class program-system :depends-on ("asdf") :components ((:file "file1")) :epilogue-code (progn (format t "~:[~Oops, no ASDF~;Look ma, ASDF~]!~%" (find-package :asdf)) (format t "~:[But no TEST-PACKAGE :-( ~;And TEST-PACKAGE~]!~%" (find-package :test-package)) (uiop:quit 0))) (operate 'program-op 'hello-asdf :force t) (DBG :run (output-file 'program-op 'hello-asdf)) (assert-equal (run-program `(,(native-namestring (output-file 'program-op 'hello-asdf))) :output :lines :error-output t) '("Look ma, ASDF!" "And TEST-PACKAGE!")) (DBG "Now create an program with explicit ASDF dependency") (register-directory *asdf-directory*) (with-asdf-cache (:override t) (load-asd (subpathname *asdf-directory* "asdf.asd")) ;; force re-loading ASDF, from source (assert-pathname-equal (truename (pathname-directory-pathname (output-file 'lib-op (asdf/bundle::linkable-system "asdf")))) (truename (resolve-output "asdf/"))) (operate 'program-op 'hello-asdf :force t) (DBG :run (output-file 'program-op 'hello-asdf)) (assert-equal (run-program `(,(native-namestring (output-file 'program-op 'hello-asdf))) :output :lines :error-output t) '("Look ma, ASDF!" "And TEST-PACKAGE!")))) ;;; TODO: include a regular system dependency and a prebuilt-system in the executable.