Merge jv
authorJan Vrany <jan.vrany@fit.cvut.cz>
Sun, 01 Jan 2017 21:55:50 +0000
branchjv
changeset 4254 7cccdc94fa82
parent 4253 3f1649b3838f (current diff)
parent 4246 c4093b605f67 (diff)
child 4255 a659739be9c2
Merge
UnixPTYStream.st
--- a/Archiver.st	Thu Dec 29 00:16:48 2016 +0000
+++ b/Archiver.st	Sun Jan 01 21:55:50 2017 +0000
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  COPYRIGHT (c) 2003 by eXept Software AG
               All Rights Reserved
@@ -354,6 +356,12 @@
     outStream := something.
 !
 
+outStream:anOutStream errorStream:anErrorStream synchron:aBoolean
+    outStream := anOutStream.
+    errorStream := anErrorStream.
+    synchron := aBoolean
+!
+
 process
     "return the value of the instance variable 'process' (automatically generated)"
 
@@ -393,6 +401,10 @@
     self extractFiles:nil to:aDirectory
 !
 
+getCommandToListFiles:aColOfFiles
+    self subclassResponsibility.
+!
+
 listFiles:aColOfFiles
     |cmd dir|
 
@@ -409,7 +421,6 @@
 !
 
 removeFilesFromArchive:aColOfFiles
-
     self subclassResponsibility.
 ! !
 
@@ -433,50 +444,39 @@
 !
 
 stopProcess
+    |p|
 
-    process notNil ifTrue:[
-        process terminateWithAllSubprocessesInGroup.
-        process waitUntilTerminated.
+    p := process.
+    p notNil ifTrue:[
+        p terminateGroup.
+        p waitUntilFinished.
+        process := nil.
     ].
 ! !
 
 !Archiver methodsFor:'command execution'!
 
 executeCommand:cmd directory:aDirectory
+    |osProcess|
+
     cmd isNil ifTrue:[
         errorStream nextPutAll:'No command for archive operation.'.
         ^ false
     ].
+    osProcess := OSProcess new
+                    command:cmd;
+                    lineWise:true;          "do it lineWise, since outStream may be an ActorStream"
+                    outStream:outStream;
+                    errorStream:errorStream;
+                    directory:aDirectory.
 
     synchron isNil ifTrue:[synchron := true].
     synchron ifTrue:[
-        ^ OperatingSystem 
-            executeCommand:cmd
-            inputFrom:nil
-            outputTo:outStream
-            errorTo:errorStream
-            inDirectory:aDirectory
-            lineWise:true
-            onError:[:status| false].
+        ^ osProcess execute.
     ] ifFalse:[
-        process := Process for:[
-                [ 
-                     OperatingSystem 
-                        executeCommand:cmd
-                        inputFrom:nil
-                        outputTo:outStream
-                        errorTo:errorStream
-                        inDirectory:aDirectory
-                        lineWise:true
-                        onError:[:status| false].
-                ] ensure:[
-                    process := nil.
-                ].
-
-        ] priority:(Processor userBackgroundPriority).
-        process name:('Archiver command: ', cmd).
-        process resume.
-        ^true
+        osProcess terminateActionBlock:[process := nil].
+        process := osProcess.
+        ^ osProcess startProcess.
     ]
 
     "Modified: / 16-09-2011 / 16:32:37 / cg"
@@ -494,19 +494,6 @@
     reader := ArchiverOutputParser new.
     reader archiver:self.
     ^ reader
-!
-
-outStream:aOutStream errorStream:aErrorStream
-
-    outStream := aOutStream.
-    errorStream := aErrorStream.
-!
-
-outStream:aOutStream errorStream:aErrorStream synchron:aBoolean
-
-    outStream := aOutStream.
-    errorStream := aErrorStream.
-    synchron := aBoolean
 ! !
 
 !Archiver methodsFor:'command strings'!
@@ -524,7 +511,6 @@
 !Archiver methodsFor:'initialization & release'!
 
 release
-
     self stopProcess.
     self removeTemporaryDirectory.
     super release
--- a/RunArray.st	Thu Dec 29 00:16:48 2016 +0000
+++ b/RunArray.st	Sun Jan 01 21:55:50 2017 +0000
@@ -660,21 +660,18 @@
 
     |otherContents idx1 idx2 runCount1 runValue1 runCount2 runValue2|
 
-    aCollection class == self class ifFalse:[
+    aCollection class ~~ self class ifTrue:[
+        idx1 := 1.
         aCollection isSequenceable ifTrue:[
-            idx1 := 1.
             self do:[:element |
                 idx1 > aCollection size ifTrue:[^ false].
                 element = (aCollection at:idx1) ifFalse:[^ false].
                 idx1 := idx1+1.
             ].
-            idx1 > aCollection size ifFalse:[^ false].
-            ^ true.
+            ^ idx1 > aCollection size.
         ].
 
-        idx1 := 1.
         runCount1 := 0.
-
         aCollection do:[:element |
             runCount1 == 0 ifTrue:[
                 idx1 >= contentsArray size ifTrue:[^ false].
@@ -687,24 +684,20 @@
             runCount1 := runCount1 - 1.
         ].
         runCount1 ~~ 0 ifTrue:[^ false].
-        idx1 >= contentsArray size ifFalse:[^ false].
-        ^ true
+        ^ idx1 >= contentsArray size.
     ].
+
     otherContents := aCollection getContentsArray.
     otherContents = contentsArray ifTrue:[^ true].
 
-    idx1 := 1.
-    runCount1 := 0.
-
-    idx2 := 1.
-    runCount2 := 0.
+    idx1 := idx2 := 1.
+    runCount1 := runCount2 := 0.
 
     [
         runCount1 == 0 ifTrue:[
             idx1 >= contentsArray size ifTrue:[
                 idx2+1 <= otherContents size ifTrue:[^ false].
-                runCount2 ~~ 0 ifTrue:[^ false].
-                ^ true.
+                ^ runCount2 == 0.
             ].
             runCount1 := contentsArray at:idx1.
             runValue1 := contentsArray at:idx1+1.
--- a/UnixPTYStream.st	Thu Dec 29 00:16:48 2016 +0000
+++ b/UnixPTYStream.st	Sun Jan 01 21:55:50 2017 +0000
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  COPYRIGHT (c) 1998 by eXept Software AG
               All Rights Reserved
@@ -182,8 +184,7 @@
 openPTYFor:aCommandString withMode:openMode inDirectory:aDirectory
     "open a pty to the unix command in commandString"
 
-    |blocked ptyFdArray execFdArray slaveFd masterFd shellAndArgs
-     shellPath shellArgs mbx mbxName env|
+    |ptyFdArray slaveFd masterFd env remotePipeEnd result osProcess|
 
     handle notNil ifTrue:[
         "the pipe was already open ...
@@ -192,113 +193,54 @@
     ].
         
     lastErrorNumber := nil.
-    exitStatus := nil.
-    exitSema := Semaphore new name:'pty exitSema'.
+    "stdio lib does not work with blocking pipes and interrupts
+     for WIN, Linux, Solaris and probably any other UNIX"
+    buffered := false.
+    hitEOF := false.
+    binary := false.
     
-    OperatingSystem isVMSlike ifTrue:[
-        mbx := OperatingSystem createMailBox.
-        mbx isNil ifTrue:[
-            lastErrorNumber := OperatingSystem currentErrorNumber.
-            ^ self openError
-        ].
-        mbxName := OperatingSystem mailBoxNameOf:mbx.
-        "/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR.
-
-        shellPath := ''.
-        shellArgs := aCommandString.
+    ptyFdArray := OperatingSystem makePTYPair.
+    ptyFdArray isNil ifTrue:[
+        lastErrorNumber := OperatingSystem lastErrorNumber.
+        ^ self openError:lastErrorNumber.
+    ].
 
-        execFdArray := Array with:mbx with:mbx with:mbx.
-    ] ifFalse:[
-        ptyFdArray := OperatingSystem makePTYPair.
-        ptyFdArray isNil ifTrue:[
-            lastErrorNumber := OperatingSystem currentErrorNumber.
-            ^ self openError
-        ].
+    masterFd := ptyFdArray at:1.
+    slaveFd := ptyFdArray at:2.
 
-        shellAndArgs := OperatingSystem commandAndArgsForOSCommand:aCommandString.
-        shellPath := shellAndArgs at:1.
-        shellArgs := shellAndArgs at:2.
-
-        masterFd := ptyFdArray at:1.
-        slaveFd := ptyFdArray at:2.
-        execFdArray := Array with:slaveFd with:slaveFd with:slaveFd.
-    ].
+    remotePipeEnd := self class forFileDescriptor:slaveFd mode:#readwrite buffered:false handleType:#pipeFilePointer.
 
     env := Dictionary new.
     env at:'TERM'  put:'dumb'.
-    env at:'SHELL' put:shellPath.
-
-    "/ must block here, to avoid races due to early finishing
-    "/ subprocesses ...
-
-    blocked := OperatingSystem blockInterrupts.
+    env at:'SHELL' put:'/bin/sh'.
 
-    pid := Processor 
-               monitor:[
-                  OperatingSystem 
-                      exec:shellPath
-                      withArguments:shellArgs
-                      environment:env
-                      fileDescriptors:execFdArray
-                      fork:true
-                      newPgrp:true
-                      inDirectory:aDirectory
-                      showWindow:nil.
-               ]
-               action:[:status |
-                  status stillAlive ifFalse:[
-                      exitStatus := status.
-                      OperatingSystem closePid:pid.
-                      pid := nil.
-                      exitSema signal.
-                  ].
-               ].
+    osProcess := OSProcess new 
+                    command:aCommandString;
+                    directory:aDirectory;
+                    environment:env;
+                    inStream:remotePipeEnd;
+                    outStream:remotePipeEnd;
+                    errorStream:remotePipeEnd.
 
-    (OperatingSystem isVMSlike) ifFalse:[
-        OperatingSystem closeFd:slaveFd.
+    result := osProcess startProcess.
+
+    remotePipeEnd notNil ifTrue:[
+        remotePipeEnd close.
     ].
 
-    pid notNil ifTrue:[
-        (OperatingSystem isVMSlike) ifTrue:[
-            "/
-            "/ reopen the mailbox as a file ...
-            "/
-            mbxName := OperatingSystem mailBoxNameOf:mbx.
-            mbxName notNil ifTrue:[
-                self open:mbxName withMode:openMode
-            ].
-        ] ifFalse:[
-            self setFileHandle:masterFd mode:openMode.
-        ]
+    result ifTrue:[
+        self setFileHandle:masterFd mode:openMode.
     ] ifFalse:[
-        lastErrorNumber := OperatingSystem currentErrorNumber.
-        OperatingSystem isVMSlike ifTrue:[
-            OperatingSystem destroyMailBox:mbx
-        ] ifFalse:[
-            OperatingSystem closeFd:masterFd.
-        ].
+        "the pipe open failed for some reason ...
+         ... this may be either due to an invalid command string,
+         or due to the system running out of memory (when forking
+         the unix process)"
+        lastErrorNumber := OperatingSystem lastErrorNumber.
+        OperatingSystem closeFd:masterFd.
+        ^ self openError:lastErrorNumber.
     ].
 
-    blocked ifFalse:[
-        OperatingSystem unblockInterrupts
-    ].
-
-    lastErrorNumber notNil ifTrue:[
-        "
-         the pipe open failed for some reason ...
-         ... this may be either due to an invalid command string,
-         or due to the system running out of memory (when forking
-         the unix process)
-        "
-        ^ self openError
-    ].
-
-    commandString := aCommandString.
-    buffered := false.
-
-    hitEOF := false.
-    binary := false.
-    Lobby register:self.
+    self registerForFinalization.
 
     "Created: / 9.7.1998 / 20:21:42 / cg"
     "Modified: / 9.7.1998 / 20:28:31 / cg"