test-program.script 5.3 KB
Newer Older
1
;;; -*- Lisp -*-
2
3
(DBG :foo (current-lisp-file-pathname))

4
(unless (or #+(or allegro (and clisp os-unix) clozure cmucl (and ecl (not ecl-bytecmp)) lispworks mkcl sbcl scl) t)
5
  (DBG "Creating images is not supported on your CL implementation")
6
7
  (leave-test "Skipping test" 0))

8
(assert (find-system :hello-world-example))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
9

10
;; Try to load lisp-invocation from xcvb
11
12
13
14
15
16
(initialize-source-registry
 `(:source-registry
   (:directory ,*asdf-directory*)
   (:directory (,*asdf-directory* "uiop/"))
   (:tree (,*asdf-directory* "ext/"))
   :inherit-configuration))
17
(unless (find-system :lisp-invocation nil)
18
  (leave-test "Couldn't find lisp-invocation. Probably your ASDF ext/ directory needs submodule update." 1))
19
(unless (version-satisfies (find-system "lisp-invocation") "1.0.12")
20
  (leave-test "Lisp-invocation library isn't new enough to test successfully. Probably your ASDF ext/ directory needs submodule update." 1))
21
(load-system "lisp-invocation/all")
22
23
24
;; Disable any user source registry.
(initialize-source-registry `(:source-registry :ignore-inherited-configuration))

25
26
27
28
(defun make-hello-world (kind)
  (assert-equal
   0
   (nth-value 2
29
    (lisp-invocation:invoke-lisp
30
     :implementation-type (lisp-invocation/allegro-variants:current-lisp-variant)
31
32
     :cross-compile nil
     :load (native-namestring (subpathname *test-directory* "make-hello-world.lisp"))
33
     :eval (format nil "(asdf-test::make-hello-~(~a~))" kind)
34
35
36
37
     :run-program-args
     `(:input nil :ignore-error-status t
       :output (,*standard-output* :linewise t :prefix "stdout: ")
       :error-output (,*error-output* :linewise t :prefix "stderr: "))))))
38

39
40
41
42
43
44
45
(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)
46
  #+cmucl
47
48
  (unless (probe-file* img)
    (leave-test "CMUCL seemingly can't find the 32-bit compiler and libraries required to dump images. Aborting test." 0))
49
  (assert (probe-file* img) () "Can't find image file ~S" img)
50

51
  (DBG "- then use this executable image")
52
53
54
  (assert-equal
   (nest
    #+lispworks (last)
55
    (lisp-invocation:invoke-lisp
56
     :implementation-type (lisp-invocation/allegro-variants:current-lisp-variant)
57
58
59
60
     :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)))
61
   '("hello, world"))
62

63
  (DBG "- now, use this executable image with arguments")
64
65
  #-(or lispworks scl) ;; These can't be passed arguments the normal way
  (assert-equal
66
   (lisp-invocation:invoke-lisp
67
    :implementation-type (lisp-invocation/allegro-variants:current-lisp-variant)
68
69
70
71
72
    :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))
73
74
75
76
77
   '("hello, world"
     "You passed 3 arguments:"
     "  \"a\""
     "  \"b c\""
     "  \"d\"")))
78

79
80
81
(progn
  (DBG "test program-op")
  (unless (or #+(or clisp clozure (and ecl (not ecl-bytecmp)) lispworks mkcl sbcl) t
82
              #+cmucl nil ;; uncomment if you have 32-bit gcc support - or can autodetect
83
84
85
86
87
              #+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))
88

89
90
91
92
93
94
  (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)
95

96
  (DBG "- use that standalone program")
97
98
  (assert-equal (run-program `(,(native-namestring exe)) :output :lines :error-output t)
                '("hello, world"))
99

100
  (DBG "- use that standalone program with arguments")
101
102
103
104
105
106
  (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\"")))
107

108
109
110
#+(or ecl mkcl)
(progn
  (DBG "Now create an program without UIOP")
111
112
  (assert (probe-file (asdf/bundle::system-module-pathname "asdf")))
  (assert (probe-file (asdf/bundle::system-module-pathname "cmp")))
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
  (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 :-(~;But TEST-PACKAGE~]!~%" (find-package :test-package))
      #+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!" "But TEST-PACKAGE!")))

129
;;; TODO: include a regular system dependency and a prebuilt-system in the executable.