Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Didier Verna
asdf
Commits
71f77d62
Commit
71f77d62
authored
Mar 21, 2014
by
Francois-Rene Rideau
Browse files
Fix image-op and program-op on ECL.
Fix test-program.script on allegro.
parent
1e9eccfd
Changes
3
Hide whitespace changes
Inline
Side-by-side
bundle.lisp
View file @
71f77d62
...
@@ -492,16 +492,16 @@ itself.")) ;; operation on a system and its dependencies
...
@@ -492,16 +492,16 @@ itself.")) ;; operation on a system and its dependencies
(
let*
((
object-files
(
input-files
o
c
))
(
let*
((
object-files
(
input-files
o
c
))
(
output
(
output-files
o
c
))
(
output
(
output-files
o
c
))
(
bundle
(
first
output
))
(
bundle
(
first
output
))
(
targetp
(
eq
(
type-of
o
)
(
component-build-operation
c
)
))
(
programp
(
typep
o
'program-op
))
(
kind
(
bundle-type
o
)))
(
kind
(
bundle-type
o
)))
(
when
output
(
when
output
(
apply
'create-image
(
apply
'create-image
bundle
(
append
object-files
(
bundle-op-lisp-files
o
))
bundle
(
append
object-files
(
bundle-op-lisp-files
o
))
:kind
kind
:kind
kind
:prologue-code
(
or
(
prologue-code
o
)
(
when
target
p
(
prologue-code
c
)))
:prologue-code
(
or
(
prologue-code
o
)
(
when
program
p
(
prologue-code
c
)))
:epilogue-code
(
or
(
epilogue-code
o
)
(
when
target
p
(
epilogue-code
c
)))
:epilogue-code
(
or
(
epilogue-code
o
)
(
when
program
p
(
epilogue-code
c
)))
:build-args
(
bundle-op-build-args
o
)
:build-args
(
bundle-op-build-args
o
)
(
when
target
p
`
(
:entry-point
,
(
component-entry-point
c
))))))))
(
when
program
p
`
(
:entry-point
,
(
component-entry-point
c
))))))))
#+
mkcl
#+
mkcl
(
with-upgradability
()
(
with-upgradability
()
...
...
test/test-program.script
View file @
71f77d62
;;; -*- Lisp -*-
;;; -*- Lisp -*-
(DBG :foo (current-lisp-file-pathname))
(DBG :foo (current-lisp-file-pathname))
(unless (or #+(or allegro clisp clozure cmu (and ecl (not ecl-bytecmp)) lispworks mkcl sbcl scl) t)
(unless (or #+(or allegro clisp clozure cmu (and ecl (not ecl-bytecmp)) lispworks mkcl sbcl scl) t)
...
@@ -8,6 +7,10 @@
...
@@ -8,6 +7,10 @@
(assert (find-system :hello-world-example))
(assert (find-system :hello-world-example))
#+allegro
(defparameter *lisp*
(truename (subpathname #p"sys:" (first (raw-command-line-arguments)))))
;; Try to load lisp-invocation from xcvb
;; Try to load lisp-invocation from xcvb
(setf *central-registry*
(setf *central-registry*
(list *asdf-directory* ;; be sure that *OUR* asdf is first of any possible ASDF
(list *asdf-directory* ;; be sure that *OUR* asdf is first of any possible ASDF
...
@@ -26,32 +29,37 @@
...
@@ -26,32 +29,37 @@
(DBG "test image-op")
(DBG "test image-op")
(defparameter img (output-file (make-operation 'image-op) (find-system :hello-world-example)))
(defparameter img (output-file (make-operation 'image-op) (find-system :hello-world-example)))
(assert (absolute-pathname-p img))
(assert (absolute-pathname-p img))
(delete-file-if-exists img)
(delete-file-if-exists img)
(DBG "- first create an executable image")
(assert-equal
(assert-equal
(nth-value 2
(nth-value 2
(run-program
(run-program
(symbol-call :lisp-invocation :lisp-invocation-arglist
(symbol-call :lisp-invocation :lisp-invocation-arglist
#+allegro :lisp-path #+allegro *lisp*
: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)")
:eval "(asdf-test::make-hello-image)")
:output t :error-output :output :input nil))
:output t :error-output :output :input nil))
0)
0)
(assert (probe-file* img) () "Can't find image file ~S" img)
(assert (probe-file* img) () "Can't find image file ~S" img)
(DBG "- then, use it")
(assert-equal
(assert-equal
(nest
(nest
#+lispworks (last)
#+lispworks (last)
(run-program
(run-program
(symbol-call :lisp-invocation :lisp-invocation-arglist
(symbol-call :lisp-invocation :lisp-invocation-arglist
#+allegro :lisp-path #+allegro *lisp*
:image-path (native-namestring img)
:image-path (native-namestring img)
:eval "(uiop:restore-image :entry-point 'hello:entry-point :lisp-interaction nil)")
:eval "(uiop:restore-image :entry-point 'hello:entry-point :lisp-interaction nil)")
:output :lines :error-output t))
:output :lines :error-output t))
'("hello, world"))
'("hello, world"))
(DBG "- now, use it with arguments")
#-(or lispworks scl) ;; These can't be passed arguments the normal way
#-(or lispworks scl) ;; These can't be passed arguments the normal way
(assert-equal
(assert-equal
(run-program
(run-program
(symbol-call :lisp-invocation :lisp-invocation-arglist
(symbol-call :lisp-invocation :lisp-invocation-arglist
#+allegro :lisp-path #+allegro *lisp*
:image-path (native-namestring img)
:image-path (native-namestring img)
:eval "(uiop:restore-image :entry-point 'hello:entry-point :lisp-interaction nil)"
:eval "(uiop:restore-image :entry-point 'hello:entry-point :lisp-interaction nil)"
:arguments '("a" "b c" "d"))
:arguments '("a" "b c" "d"))
...
@@ -74,10 +82,12 @@
...
@@ -74,10 +82,12 @@
(defparameter exe (output-file (make-operation 'program-op) (find-system :hello-world-example)))
(defparameter exe (output-file (make-operation 'program-op) (find-system :hello-world-example)))
(assert (absolute-pathname-p exe))
(assert (absolute-pathname-p exe))
(delete-file-if-exists exe)
(delete-file-if-exists exe)
(DBG "- first, create the standalone program")
(assert-equal
(assert-equal
(nth-value 2
(nth-value 2
(run-program
(run-program
(symbol-call :lisp-invocation :lisp-invocation-arglist
(symbol-call :lisp-invocation :lisp-invocation-arglist
#+allegro :lisp-path #+allegro *lisp*
: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-program)")
:eval "(asdf-test::make-hello-program)")
:output t :error-output :output :input nil))
:output t :error-output :output :input nil))
...
@@ -85,9 +95,11 @@
...
@@ -85,9 +95,11 @@
(assert (probe-file* exe) () "Can't find executable file ~S" exe)
(assert (probe-file* exe) () "Can't find executable file ~S" exe)
(DBG "- use that")
(assert-equal (run-program `(,(native-namestring exe)) :output :lines :error-output t)
(assert-equal (run-program `(,(native-namestring exe)) :output :lines :error-output t)
'("hello, world"))
'("hello, world"))
(DBG "- use that with arguments")
(assert-equal (run-program `(,(native-namestring exe) "a" "b c" "d") :output :lines :error-output t)
(assert-equal (run-program `(,(native-namestring exe) "a" "b c" "d") :output :lines :error-output t)
'("hello, world"
'("hello, world"
"You passed 3 arguments:"
"You passed 3 arguments:"
...
...
uiop/image.lisp
View file @
71f77d62
...
@@ -438,8 +438,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
...
@@ -438,8 +438,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
((
:image
)
((
:image
)
(
setf
kind
:program
)
;; to ECL, it's just another program.
(
setf
kind
:program
)
;; to ECL, it's just another program.
`
((
setf
*image-dumped-p*
t
)
`
((
setf
*image-dumped-p*
t
)
;; fall through should be equivalent to: (si::top-level t) (quit)
(
si::top-level
t
)
(
quit
)))
))
((
:program
)
((
:program
)
`
((
setf
*image-dumped-p*
:executable
)
`
((
setf
*image-dumped-p*
:executable
)
(
shell-boolean-exit
(
shell-boolean-exit
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment