mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-25 05:51:55 -08:00
Code Issues Projects Releases Packages Wiki Activity

tests: fix embedding tests on cygwin

Browse source
This commit is contained in:
Marius Gerbershagen 2020-02-29 20:11:54 +01:00
parent fd7b4c6f85
commit 313d553918
1 changed files with 37 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

65
src/tests/normal-tests/embedding.lsp
View file

@ -16,34 +16,43 @@
(princ c-code s))
(c::compiler-cc "tmp/ecl-aux.c" "tmp/ecl-aux.o")
(c::linker-cc "tmp/ecl-aux.exe" '("tmp/ecl-aux.o"))
(ecase capture-output
((nil)
(return-from test-C-program (zerop (si::system #+windows (format nil "PATH=%PATH%;~a tmp\\ecl-aux.exe" c::*ecl-library-directory*)
#-windows "tmp/ecl-aux.exe"))))
((string :string)
(with-output-to-string (s)
(let ((in (si::run-program "tmp/ecl-aux.exe" '() :output :stream
:environ (append #+windows (list (format nil "PATH=~a;~a"
(ext:getenv "PATH")
c::*ecl-library-directory*))
(ext:environ))))
line)
(loop
(setf line (read-line in nil))
(unless line (return))
(write-line line s)))))
((t forms :forms)
(do* ((all '())
(x t)
(in (si::run-program "tmp/ecl-aux.exe" '() :output :stream
:environ (append #+windows (list (format nil "PATH=~a;~a"
(ext:getenv "PATH")
c::*ecl-library-directory*))
(ext:environ)))))
((null in) all)
(setf x (ignore-errors (read in nil nil)))
(unless x (return all))
(push x all)))))
(let ((environment
(append #+windows (list (format nil "PATH=~a;~a"
(ext:getenv "PATH")
c::*ecl-library-directory*))
#+cygwin (list (format nil "PATH=~a:~a"
(ext:getenv "PATH")
c::*ecl-library-directory*))
#-(or windows cygwin) (list (format nil "LD_LIBRARY_PATH=~a:~a"
(ext:getenv "LD_LIBRARY_PATH")
c::*ecl-library-directory*))
(ext:environ))))
(ecase capture-output
((nil)
(multiple-value-bind (stream return-code)
(si::run-program "tmp/ecl-aux.exe" '()
:output t :error t
:environ environment)
(declare (ignore stream))
(zerop return-code)))
((string :string)
(with-output-to-string (s)
(let ((in (si::run-program "tmp/ecl-aux.exe" '() :output :stream
:environ environment))
line)
(loop
(setf line (read-line in nil))
(unless line (return))
(write-line line s)))))
((t forms :forms)
(do* ((all '())
(x t)
(in (si::run-program "tmp/ecl-aux.exe" '() :output :stream
:environ environment)))
((null in) all)
(setf x (ignore-errors (read in nil nil)))
(unless x (return all))
(push x all))))))
;;; Date: 21/06/2006 (goffioul)
;;; Fixed: 23/06/2006 (juanjo)