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

4
(unless (or #+(or allegro clisp clozure cmu (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
(trace run-program #+(and sbcl os-windows) sb-ext:run-program)
Robert P. Goldman's avatar
Robert P. Goldman committed
11

12
13
#+allegro
(defparameter *lisp*
14
15
16
  (let ((argv0 (parse-native-namestring (first (raw-command-line-arguments)))))
    (or (absolute-pathname-p argv0)
        (truename (subpathname #p"sys:" argv0)))))
17

18
;; Try to load lisp-invocation from xcvb
19
20
21
22
23
24
(initialize-source-registry
 `(:source-registry
   (:directory ,*asdf-directory*)
   (:directory (,*asdf-directory* "uiop/"))
   (:tree (,*asdf-directory* "ext/"))
   :inherit-configuration))
25
(unless (find-system :lisp-invocation nil)
26
  (leave-test "Couldn't find lisp-invocation. Probably your ASDF ext/ directory needs submodule update." 1))
27
(unless (version-satisfies (find-system "lisp-invocation") "1.0.11")
28
  (leave-test "Lisp-invocation library isn't new enough to test successfully. Probably your ASDF ext/ directory needs submodule update." 1))
29
(load-system "lisp-invocation/all")
30
31
32
;; Disable any user source registry.
(initialize-source-registry `(:source-registry :ignore-inherited-configuration))

33
34
35
36
(defun make-hello-world (kind)
  (assert-equal
   0
   (nth-value 2
37
38
39
40
    (lisp-invocation:invoke-lisp
     #+allegro :lisp-path #+allegro *lisp*
     :cross-compile nil
     :load (native-namestring (subpathname *test-directory* "make-hello-world.lisp"))
41
     :eval (format nil "(asdf-test::make-hello-~(~a~))" kind)
42
43
44
45
     :run-program-args
     `(:input nil :ignore-error-status t
       :output (,*standard-output* :linewise t :prefix "stdout: ")
       :error-output (,*error-output* :linewise t :prefix "stderr: "))))))
46

47
#-(and ecl os-macosx)
48
49
50
51
52
53
54
(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)
55
56
57
  #+cmu
  (unless (probe-file* img)
    (leave-test "CMUCL seemingly can't find the 32-bit compiler and libraries required to dump images. Aborting test." 0))
58
  (assert (probe-file* img) () "Can't find image file ~S" img)
59

60
  (DBG "- then use this executable image")
61
62
63
  (assert-equal
   (nest
    #+lispworks (last)
64
65
66
67
68
69
    (lisp-invocation:invoke-lisp
     #+allegro :lisp-path #+allegro *lisp*
     :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)))
70
   '("hello, world"))
71

72
  (DBG "- now, use this executable image with arguments")
73
74
  #-(or lispworks scl) ;; These can't be passed arguments the normal way
  (assert-equal
75
76
77
78
79
80
81
   (lisp-invocation:invoke-lisp
    #+allegro :lisp-path #+allegro *lisp*
    :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))
82
83
84
85
86
   '("hello, world"
     "You passed 3 arguments:"
     "  \"a\""
     "  \"b c\""
     "  \"d\"")))
87

88
#-(and ecl os-macosx)
89
90
91
92
93
94
95
96
97
(progn
  (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))
98

99
100
101
102
103
104
  (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)
105

106
  (DBG "- use that standalone program")
107
108
  (assert-equal (run-program `(,(native-namestring exe)) :output :lines :error-output t)
                '("hello, world"))
109

110
  (DBG "- use that standalone program with arguments")
111
112
113
114
115
116
  (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\"")))
117

118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
#+(or ecl mkcl)
(progn
  (DBG "Now create an program without UIOP")
  (assert (probe-file (asdf/bundle::asdf-library-pathname)))
  (assert (probe-file (asdf/bundle::compiler-library-pathname)))
  (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!")))

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