Restore compilation on Java 6

JSR-223 is always present so usage in <file:build.xml> is deprecated.

Fix compilation for SYS:RUN-PROGRAM on Java 6.  Not expected to be
working very well.  The general strategy is to undeprecate
SYS:RUN-SHELL-COMMAND is some manner that uses the Java 6 NIO plus
thread pools to drain IO.

Conditionalize on runtime platform of parts of our RUN-PROGRAM

Stub implementation of NIO async processor to drain queue.

TODO: figure out how why "cat /etc/passwd" doesn't ever give output?
parent 0356ded5
......@@ -59,6 +59,8 @@
(:file "package-local-nicknames-tests")))))
;;; FIXME Currently requires ACBL-CONTRIB and QUICKLISP-ABCL to be
;;; loaded, but can't seem to put in the :defsystem-depends-on stanza
(defsystem abcl/t
:description "Tests for ABCL via PROVE."
:defsystem-depends-on (prove-asdf)
......@@ -69,6 +71,10 @@
:components ((:module package
:pathname "t/"
:components ((:file "package")))
(:module java6
:depends-on (package)
:pathname "t/"
:components ((:test-file "run-program")))
(:module build
:depends-on (package)
:pathname "t/"
......@@ -48,6 +48,7 @@ For help on the automatic tests available, use the Ant target 'help.test'.
<property name="abcl.runtime.jar.path"
<!-- TODO verify me -->
<fail message="Please build using Ant 1.7.1 or higher.">
......@@ -56,7 +57,7 @@ For help on the automatic tests available, use the Ant target 'help.test'.
<!-- Checks if JSR-223 support is available - thanks to Mark Evenson -->
<!-- Deprecated. Checks if JSR-223 support is available. Should always be true. Unused. D -->
<available property="abcl.jsr-223.p"
......@@ -65,11 +66,10 @@ For help on the automatic tests available, use the Ant target 'help.test'.
<include name="org/armedbear/lisp/util/*.java"/>
<include name="org/armedbear/lisp/protocol/*.java"/>
<include name="org/armedbear/lisp/java/**/*.java"/>
<include if="abcl.jsr-223.p"
name="org/armedbear/lisp/scripting/*.java" />
<include if="abcl.jsr-223.p"
name="org/armedbear/lisp/scripting/util/*.java" />
<include name="org/armedbear/lisp/scripting/*.java" />
<include name="org/armedbear/lisp/scripting/util/*.java" />
<include name="org/armedbear/"/>
<include name="org/abcl/**/*.java"/>
<patternset id="abcl.source.lisp">
......@@ -77,14 +77,13 @@ For help on the automatic tests available, use the Ant target 'help.test'.
<include name="org/armedbear/lisp/java/**/*.lisp"/>
<include name="org/armedbear/lisp/tests/*.lisp"/>
<exclude name="org/armedbear/lisp/j.lisp"/>
<include if="abcl.jsr-223.p" name="org/armedbear/lisp/scripting/lisp/*.lisp"/>
<include name="org/armedbear/lisp/scripting/lisp/*.lisp"/>
<!-- Lisp files required at runtime -->
<patternset id="abcl.source.lisp.dist">
<include name="org/armedbear/lisp/boot.lisp"/>
<include if="abcl.jsr-223.p"
name="org/armedbear/lisp/scripting/lisp/*.lisp" />
<include name="org/armedbear/lisp/scripting/lisp/*.lisp" />
<include if="abcl.compile.lisp.skip"
name="**/*.lisp" />
......@@ -95,11 +94,10 @@ For help on the automatic tests available, use the Ant target 'help.test'.
<include name="org/armedbear/lisp/**/*.class"/>
<include name="org/armedbear/lisp/**/*.cls"/>
<include name="org/armedbear/lisp/**/*.abcl"/>
<include name="org/abcl/util/*.class"/>
<include name="org/armedbear/lisp/version"/>
<include if="abcl.jsr-223.p"
<include if="abcl.jsr-223.p"
<include name="org/armedbear/lisp/scripting/*.class"/>
<include name="org/armedbear/lisp/scripting/util/*.class"/>
<patternset refid="abcl.source.lisp.dist"/>
<include name="abcl.rdf"/>
<include name="abcl.asd"/>
......@@ -160,9 +158,11 @@ For help on the automatic tests available, use the Ant target 'help.test'.
<echo>java.version: ${java.version}</echo>
<condition property="">
<!-- Unsupported as of abcl-1.5.0 due to lack of open jdk
<matches string="${java.version}"
<!-- Don't use 1.6.0_09 or earlier. -->
<matches string="${java.version}"
......@@ -181,7 +181,8 @@ For help on the automatic tests available, use the Ant target 'help.test'.
<echo>WARNING: Use of Java version ${java.version} not recommended.</echo>
<!-- Deprecated. JSR-223 is always present -->
<target name="abcl.jsr-223.notice"
......@@ -193,7 +194,7 @@ For help on the automatic tests available, use the Ant target 'help.test'.
<target name=""
<mkdir dir="${build.dir}"/>
<mkdir dir="${build.classes.dir}"/>
<!-- abcl-1.5.0: Stock build for Java 1.6 (aka Java 2) container -->
......@@ -503,8 +504,6 @@ from ${abcl.home.dir}
<metainf dir="${src.dir}/META-INF">
<exclude name="services/javax.script.ScriptEngineFactory"
......@@ -555,8 +554,6 @@ from ${abcl.home.dir}
<metainf dir="${src.dir}/META-INF">
<exclude name="services/javax.script.ScriptEngineFactory"
......@@ -28,10 +28,14 @@
;;; this exception to your version of the library, but you are not
;;; obligated to do so. If you do not wish to do so, delete this
;;; exception statement from your version.
(in-package :system)
(in-package "SYSTEM")
(require :java)
(require "JAVA")
(defparameter *implementations*
'(:java-1.6 :java-1.7 :java-1.8)) ;; UNUSED
(defun not-java-6 ()
(not (find :java-1.6 *features*)))
(export '(run-program process process-p process-input process-output
process-error process-alive-p process-wait process-exit-code
......@@ -143,27 +147,54 @@ The &key arguments have the following meanings:
(princ-to-string (cdr entry))))))
(let ((input-stream-p (eq input :stream))
(output-stream-p (eq output :stream))
(error-stream-p (eq error :stream)))
(error-stream-p (eq error :stream))
(unless output-stream-p
(unless (setup-output-redirection process-builder output NIL if-output-exists)
(unless (setf output-redirection
(setup-output-redirection process-builder output NIL if-output-exists))
(return-from run-program)))
(if (eq error :output)
(java:jcall "redirectErrorStream" process-builder T)
(unless error-stream-p
(unless (setup-output-redirection process-builder error T if-error-exists)
(unless (setf error-redirection
(setup-output-redirection process-builder error T if-error-exists))
(return-from run-program))))
(unless input-stream-p
(unless (setup-input-redirection process-builder input if-input-does-not-exist)
(unless (setf input-redirection
(setup-input-redirection process-builder input if-input-does-not-exist))
(return-from run-program)))
(when directory
(java:jcall "directory" process-builder (java:jnew "" (namestring directory))))
(let ((process (make-process (%process-builder-start process-builder)
input-stream-p output-stream-p error-stream-p)))
(when wait (process-wait process))
(let ((process
(if (not-java-6)
(make-process (%process-builder-start process-builder)
input-stream-p output-stream-p error-stream-p)
(make-process (%process-builder-start process-builder)
t t t))))
(when (find :java-1.6 *features*)
(when input-redirection
(let ((input (process-input process)))
(threads:make-thread (lambda () (from-file input-redirection input)))))
(when output-redirection
(let ((output (process-output process))
(file (first output-redirection))
(appendp (second output-redirection)))
(threads:make-thread (lambda () (to-file output file :append appendp)))))
(when error-redirection
(let ((error (process-error process))
(file (first output-redirection))
(appendp (second output-redirection)))
(threads:make-thread (lambda () (to-file error file :append appendp))))))
(when (or wait
(process-wait process))
(defconstant +inherit+
(java:jfield "java.lang.ProcessBuilder$Redirect" "INHERIT"))
(java:jfield "java.lang.ProcessBuilder$Redirect" "INHERIT")))
(defun coerce-to-file (value)
......@@ -178,24 +209,54 @@ The &key arguments have the following meanings:
(error "Don't know how to set up null stream on this platform."))))))
(define-condition implementation-not-available (error)
((missing :initarg :missing
:reader missing))
(:report (lambda (condition stream)
(format stream "This JVM is missing the ~a implementation." (missing condition)))))
(defun setup-input-redirection (process-builder value if-does-not-exist)
"Returns boolean truth when input redirections has been successfully set up.
As a second value, returns either nil if input should inherit from the
parent process, or a reference to the file to read input from."
(let ((redirect (if (eq value T)
;; Either inherit stdio or fail
(if (not-java-6)
(signal 'implementation-not-available
:missing "Inheritance for subprocess of standard input"))
;; or read from a file
(let ((file (coerce-to-file value)))
(when value
(if (eq if-does-not-exist :create)
(open value :direction :probe :if-does-not-exist :create)
(unless (probe-file value)
(ecase if-does-not-exist
(:error (error "Input file ~S does not exist." value))
((NIL) (return-from setup-input-redirection))))))
(java:jstatic "from" "java.lang.ProcessBuilder$Redirect" file)))))
(java:jcall "redirectInput" process-builder redirect))
(error "Input file ~S does not already exist." value))
(return-from setup-input-redirection))))))
(if (not-java-6)
(java:jstatic "from" "java.lang.ProcessBuilder$Redirect" file)
(when (not-java-6)
(java:jcall "redirectInput" process-builder redirect))
t inherit from
(defun setup-output-redirection (process-builder value errorp if-does-exist)
(let ((redirect (if (eq value T)
(if (not-java-6)
(if errorp
(signal 'implementation-not-available
:missing "Inheritance for subprocess of standard error")
(signal 'implementation-not-available
:missing "Inheritance for subprocess of standard output")))
(let ((file (coerce-to-file value))
(when (and value (probe-file value))
......@@ -207,13 +268,16 @@ The &key arguments have the following meanings:
:if-exists if-does-exist)))
(:append (setf appendp T))
((NIL) (return-from setup-output-redirection))))
(if appendp
(java:jstatic "appendTo" "java.lang.ProcessBuilder$Redirect" file)
(java:jstatic "to" "java.lang.ProcessBuilder$Redirect" file))))))
(if errorp
(java:jcall "redirectError" process-builder redirect)
(java:jcall "redirectOutput" process-builder redirect)))
(if (not-java-6)
(if appendp
(java:jstatic "appendTo" "java.lang.ProcessBuilder$Redirect" file)
(java:jstatic "to" "java.lang.ProcessBuilder$Redirect" file))
(list file appendp))))))
(when (not-java-6)
(if errorp
(java:jcall "redirectError" process-builder redirect)
(java:jcall "redirectOutput" process-builder redirect)))
;;; The process structure.
(defstruct (process (:constructor %make-process (jprocess)))
......@@ -312,3 +376,37 @@ The &key arguments have the following meanings:
(defun %process-kill (jprocess)
(java:jcall "destroy" jprocess))
(defun to-file (input &key (append nil))
(declare (ignore append)) ;; FIXME
(let ((file (java:jcall "toString"
(with-open-file (s file
:direction :output
:element-type (stream-element-type input))
(let ((buffer (make-array 8192 :element-type (stream-element-type input))))
:for bytes-read = (read-sequence buffer input)
:while (plusp bytes-read)
:do (write-sequence buffer s :end bytes-read)))))
(close input))
(defun from-file ( output)
(let ((file (java:jcall "toString"
(with-open-file (s file
:direction :input
:element-type (stream-element-type output))
(let ((buffer (make-array 8192 :element-type (stream-element-type output))))
:for bytes-read = (read-sequence buffer s)
:while (plusp bytes-read)
:do (write-sequence buffer output :end bytes-read))))
(close output)))
(uiop:run-program "uname -a" :output :string)
(uiop:run-program "cat /etc/passwd" :output :string)
(prove:plan 2)
(uiop/run-program:run-program "ls" :output t))
(uiop/run-program:run-program "ls" :output :string))
* To change this license header, choose License Headers in Project Properties.
* To change this template file, choose Tools | Templates
* and open the template in the editor.
package org.abcl.util;
import org.junit.After;
import org.junit.AfterClass;
import org.junit.Before;
import org.junit.BeforeClass;
import org.junit.Test;
import static org.junit.Assert.*;
* @author evenson
public class StreamTaskTest {
public StreamTaskTest() {
public static void setUpClass() {
public static void tearDownClass() {
public void setUp() {
public void tearDown() {
* Test of run method, of class StreamTask.
public void testRun() {
byte inputBytes[] = {65, 66, 66, 90} ;
ByteArrayInputStream input = new ByteArrayInputStream(inputBytes);
ByteArrayOutputStream output = new ByteArrayOutputStream();
StreamTask instance = new StreamTask(input, output);;
assertArrayEquals(inputBytes, output.toByteArray());
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment