├── .github └── workflows │ └── main.yml ├── .gitignore ├── .project ├── .smalltalk.ston ├── .stress.smalltalk.ston ├── .travis.yml ├── CHANGELOG.md ├── LICENSE ├── README.md ├── UCD ├── DerivedNormalizationProps.txt └── UnicodeData.txt └── repository ├── .properties ├── BaselineOfOSSubprocess ├── BaselineOfOSSubprocess.class.st └── package.st ├── ConfigurationOfOSSubprocess ├── ConfigurationOfOSSubprocess.class.st └── package.st ├── OSSubprocess-Tests-Stress ├── OSSConcurrentProcessesTest.class.st ├── OSSLongRunningProcessTest.class.st └── package.st ├── OSSubprocess-Tests-Unit ├── OSSAbstractUnixSubprocessTest.class.st ├── OSSFileBasedUnixSubprocessTest.class.st ├── OSSPipeBasedUnixSubprocessTest.class.st ├── OSSPipeTest.class.st ├── OSSUnixSubprocessTest.class.st ├── OSSVMProcessTest.class.st └── package.st ├── OSSubprocess ├── OSSAttachableFileStream.class.st ├── OSSCFile.class.st ├── OSSPipe.class.st ├── OSSTimeout.class.st ├── OSSUnixProcessExitStatus.class.st ├── OSSUnixSubprocess.class.st ├── OSSUnixSystemAccessor.class.st ├── OSSVMProcess.class.st ├── OldStandardFileStream.extension.st └── package.st └── OldFileStream ├── ManifestDeprecatedFileStream.class.st ├── OldFileExistsException.class.st ├── OldFileStream.class.st ├── OldLimitingLineStreamWrapper.class.st ├── OldMultiByteBinaryOrTextStream.class.st ├── OldMultiByteFileStream.class.st ├── OldRWBinaryOrTextStream.class.st ├── OldStandardFileStream.class.st ├── PositionableStream.extension.st └── package.st /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | # Controls when the workflow will run 2 | on: 3 | # Triggers the workflow on push or pull request events but only for the master branch 4 | push: 5 | branches: [ master ] 6 | paths-ignore: 7 | - '**.md' 8 | pull_request: 9 | branches: [ master ] 10 | paths-ignore: 11 | - '**.md' 12 | 13 | # Allows you to run this workflow manually from the Actions tab 14 | workflow_dispatch: 15 | 16 | # A workflow run is made up of one or more jobs that can run sequentially or in parallel 17 | jobs: 18 | # This workflow contains a single job called "build" 19 | build: 20 | strategy: 21 | matrix: 22 | smalltalk: 23 | - Pharo64-12 24 | - Pharo64-11 25 | smalltalk_config: [ .smalltalk.ston, .stress.smalltalk.ston ] 26 | os: [ ubuntu-latest, macos-latest ] 27 | runs-on: ${{ matrix.os }} 28 | name: ${{ matrix.smalltalk }}, ${{ matrix.smalltalk_config }} on ${{ matrix.os }} 29 | steps: 30 | - uses: actions/checkout@v2 31 | - uses: hpi-swa/setup-smalltalkCI@v1 32 | with: 33 | smalltalk-image: ${{ matrix.smalltalk }} 34 | - run: smalltalkci -s ${{ matrix.smalltalk }} ${{ matrix.smalltalk_config }} 35 | shell: bash 36 | timeout-minutes: 30 37 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | #Image files 2 | Pharo.changes 3 | Pharo.image 4 | Pharo7.0-*.sources 5 | PharoDebug.log 6 | 7 | icon-packs/ 8 | 9 | #VM files 10 | pharo 11 | pharo-local/ 12 | pharo-ui 13 | pharo-vm/ -------------------------------------------------------------------------------- /.project: -------------------------------------------------------------------------------- 1 | { 2 | 'srcDirectory' : 'repository' 3 | } -------------------------------------------------------------------------------- /.smalltalk.ston: -------------------------------------------------------------------------------- 1 | SmalltalkCISpec { 2 | #loading : [ 3 | SCIMetacelloLoadSpec { 4 | #baseline : 'OSSubprocess', 5 | #directory : 'repository', 6 | #platforms : [ #pharo ] 7 | } 8 | ], 9 | #testing : { 10 | #exclude : { 11 | #packages : [ 'OSSubprocess-Tests-Unit' ] 12 | } 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /.stress.smalltalk.ston: -------------------------------------------------------------------------------- 1 | SmalltalkCISpec { 2 | #loading : [ 3 | SCIMetacelloLoadSpec { 4 | #baseline : 'OSSubprocess', 5 | #directory : 'repository', 6 | #platforms : [ #pharo ] 7 | } 8 | ], 9 | #testing : { 10 | #include : { 11 | #packages : [ 'OSSubprocess-Tests-Stress' ] 12 | } 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: smalltalk 2 | 3 | sudo: false 4 | 5 | os: 6 | - linux 7 | - osx 8 | 9 | smalltalk: 10 | - Pharo64-10 11 | - Pharo64-9.0 12 | # Waiting a 32-bit version of Pharo 90 before re-enabling this version 13 | # - Pharo32-9.0 14 | 15 | env: 16 | matrix: 17 | - CI_FILE=.smalltalk.ston 18 | - CI_FILE=.stress.smalltalk.ston 19 | 20 | before_script: 21 | - mkdir -p $SMALLTALK_CI_BUILD/UCD && cp UCD/* $SMALLTALK_CI_BUILD/UCD/ 22 | 23 | script: 24 | - travis_wait 60 $SMALLTALK_CI_HOME/run.sh ${CI_FILE} 25 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | 5 | 6 | # Change Log 7 | 8 | ## [v1.1.1](https://github.com/pharo-contributions/OSSubProcess/compare/v1.1...v1.1.1) (2019-11-15) 9 | 10 | **Cleanings** 11 | 12 | * Remove useless postload ([39db253](https://github.com/pharo-contributions/OSSubProcess/commit/39db2530ce53dfd90221d1a2edf20cc02fc74fee)) 13 | * Add Core and Tests groups ([cb8c577](https://github.com/pharo-contributions/OSSubProcess/commit/cb8c577b0b81a419261bea05dbc3cacfe3165704)) 14 | 15 | ## [v0.2.5](https://github.com/marianopeck/OSSubprocess/tree/v0.2.5) 16 | 17 | [Full Changelog](https://github.com/marianopeck/OSSubprocess/compare/v0.2.4...v0.2.5) 18 | 19 | 20 | **Merged pull requests:** 21 | 22 | - Many enhancements [\#25](https://github.com/marianopeck/OSSubprocess/pull/25) 23 | 24 | **Documentation updates** 25 | 26 | - Added small comment on installation instructions about iTimer Linux VM issue. 27 | 28 | 29 | ## [v0.2.4](https://github.com/marianopeck/OSSubprocess/tree/v0.2.4) (2016-05-30) 30 | 31 | [Full Changelog](https://github.com/marianopeck/OSSubprocess/compare/v0.2.3...v0.2.4) 32 | 33 | **Implemented enhancements:** 34 | 35 | - Migrate from our custom Travis CI scripts to [smalltalk-ci](https://github.com/hpi-swa/smalltalkCI) 36 | **Closed issues:** 37 | 38 | - Childs processes never finished (Pharo delaySchedulerClass bug) [NOW FOR REAL] [\#19](https://github.com/marianopeck/OSSubprocess/issues/19) 39 | 40 | 41 | 42 | ## [v0.2.3](https://github.com/marianopeck/OSSubprocess/tree/v0.2.3) (2016-05-30) 43 | 44 | [Full Changelog](https://github.com/marianopeck/OSSubprocess/compare/v0.2.2...v0.2.3) 45 | 46 | **Implemented enhancements:** 47 | 48 | - Rename `pwd:` to `workingDirectory:` [\#18](https://github.com/marianopeck/OSSubprocess/issues/18) 49 | 50 | **Closed issues:** 51 | 52 | - Childs processes never finished (Pharo delaySchedulerClass bug) [\#19](https://github.com/marianopeck/OSSubprocess/issues/19) 53 | 54 | 55 | ## [v0.2.2](https://github.com/marianopeck/OSSubprocess/tree/v0.2.2) (2016-05-07) 56 | 57 | [Full Changelog](https://github.com/marianopeck/OSSubprocess/compare/v0.2.1...v0.2.2) 58 | 59 | **Closed issues:** 60 | 61 | - Problem trying to terminate already terminated childWatcher on system startup [\#17](https://github.com/marianopeck/OSSubprocess/issues/17) 62 | 63 | **Fixed bugs:** 64 | 65 | - Do not use "v" as part of the Metacello version string so that this project can be used as a dependency via Versionner until the bug is fixed in Metacello [\#392](https://github.com/dalehenrich/metacello-work/issues/392) 66 | 67 | 68 | ## [v0.2.1](https://github.com/marianopeck/OSSubprocess/tree/v0.2.1) (2016-01-31) 69 | 70 | [Full Changelog](https://github.com/marianopeck/OSSubprocess/compare/v0.2.0...v0.2.1) 71 | 72 | **Implemented enhancements:** 73 | 74 | - Added Travis CI integration 75 | - Added dependency to [FFICHeaderExtractor](https://github.com/marianopeck/FFICHeaderExtractor), needed by issue [\#15](https://github.com/marianopeck/OSSubprocess/issues/15) 76 | - Update to new `registerToolClassNamed:` mechanisim rather than `addToStartUpList:` and `addToShutDownList:` as for Pharo 50558. 77 | 78 | **Closed issues:** 79 | 80 | - Use FFICHeaderExtractor to minimize usage of OSProcess [\#15](https://github.com/marianopeck/OSSubprocess/issues/15) 81 | - `upToEnd` may fail when child process is writing [\#16](https://github.com/marianopeck/OSSubprocess/issues/16) 82 | 83 | **Merged pull requests:** 84 | 85 | - Typos in comments and a method name [\#14](https://github.com/marianopeck/OSSubprocess/pull/14) ([cdlm](https://github.com/cdlm)) 86 | 87 | **Fixed bugs:** 88 | 89 | - Fix random test failures that used `fork`. 90 | 91 | **Documentation updates** 92 | 93 | - Re-organization of the main README 94 | - Added section for [Future Work](https://github.com/marianopeck/OSSubprocess#future-work) 95 | - Added section for [Running Tests](https://github.com/marianopeck/OSSubprocess#running-the-tests) 96 | 97 | 98 | ## [v0.2.0](https://github.com/marianopeck/OSSubprocess/tree/v0.2.0) (2016-01-19) 99 | 100 | 101 | **Implemented enhancements:** 102 | 103 | - Improve `#bashCommand` to rely on $SHELL if defined [\#13](https://github.com/marianopeck/OSSubprocess/issues/13) 104 | - Add OS signal sending to process (`sigterm`, `sigkill`, etc) [\#4](https://github.com/marianopeck/OSSubprocess/issues/4) 105 | - Added API for processing streams while process is running (`#runAndWaitPollingEvery:doing:onExitDo:`) 106 | - Added option `#terminateOnShutdown` to terminate running processes on Pharo shutdown 107 | - Move creation of temp files to class side 108 | 109 | **Fixed bugs:** 110 | 111 | - VM Crash when forking infinitive process and image restart (added new `#stopWaiting` called from `#shutDown:`) [\#12](https://github.com/marianopeck/OSSubprocess/issues/12) 112 | 113 | **Closed issues:** 114 | 115 | - Double check `ExternalAddress allocate` and `free` [\#9](https://github.com/marianopeck/OSSubprocess/issues/9) 116 | 117 | **Merged pull requests:** 118 | 119 | - typos, small edits in first 200 lines [\#1](https://github.com/marianopeck/OSSubprocess/pull/1) ([StephanEggermont](https://github.com/StephanEggermont)) 120 | 121 | **Documentation updates** 122 | 123 | - Better explanation of synchronism vs asynchronous 124 | - Add a section specially for asynchronous with a `tail -f` example 125 | - Add new doc for all new features and enchacements 126 | - Added a ChangeLog file to doc. 127 | 128 | [Full Changelog](https://github.com/marianopeck/OSSubprocess/compare/v0.1.4...v0.2.0) 129 | 130 | 131 | ## [v0.1.4](https://github.com/marianopeck/OSSubprocess/tree/v0.1.4) (2016-01-14) 132 | First milestone release. 133 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2016 marianopeck 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /repository/.properties: -------------------------------------------------------------------------------- 1 | { 2 | #format : #tonel 3 | } -------------------------------------------------------------------------------- /repository/BaselineOfOSSubprocess/BaselineOfOSSubprocess.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a baseline of OSSubprocess. 3 | 4 | OSSubprocess is a software project that allows the user to spawn Operatying System processes from within Pharo language. The main usage of forking external OS processes is to be able to execute OS commands (.e.g cat, ls, ps, cp, etc) as well as arbitrary shell scripts (.e.g /etc/myShellScript.sh) from Pharo. 5 | 6 | An important part of OSSubprocess is how to manage standard streams (stdin, stdout and stderr) and how to provide an API for reading and writing from them at the language level. 7 | 8 | For more details see: https://github.com/marianopeck/OSSubprocess 9 | " 10 | Class { 11 | #name : #BaselineOfOSSubprocess, 12 | #superclass : #BaselineOf, 13 | #category : #BaselineOfOSSubprocess 14 | } 15 | 16 | { #category : #baseline } 17 | BaselineOfOSSubprocess >> baseline: spec [ 18 | 19 | spec 20 | for: #pharo 21 | do: [ 22 | spec 23 | package: 'OldFileStream'; 24 | package: 'OSSubprocess' with: [ spec requires: #('FFICHeaderExtractor' 'OldFileStream') ]; 25 | package: 'OSSubprocess-Tests-Unit' with: [ spec requires: #('OSSubprocess' 'Unicode') ]; 26 | package: 'OSSubprocess-Tests-Stress' with: [ spec requires: 'OSSubprocess-Tests-Unit' ]. 27 | 28 | spec baseline: 'FFICHeaderExtractor' with: [ 29 | spec repository: 'github://pharo-contributions/FFICHeaderExtractor:v1.0.2/repository' ]. 30 | 31 | spec baseline: 'Unicode' with: [ 32 | spec repository: 'github://pharo-contributions/pharo-unicode:v1.1.0/src' ]. 33 | 34 | spec 35 | group: 'Core' with: #( 'OSSubprocess' ); 36 | group: 'Tests' with: #( 'OSSubprocess-Tests-Unit' 'OSSubprocess-Tests-Stress' ). 37 | ] 38 | 39 | ] 40 | -------------------------------------------------------------------------------- /repository/BaselineOfOSSubprocess/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #BaselineOfOSSubprocess } 2 | -------------------------------------------------------------------------------- /repository/ConfigurationOfOSSubprocess/ConfigurationOfOSSubprocess.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a Configuration of OSSubprocess. 3 | 4 | OSSubprocess is a software project that allows the user to spawn Operating System processes from within Pharo. The main usage of forking external OS processes is to be able to execute OS commands (.e.g cat, ls, ps, cp, etc) as well as arbitrary shell scripts (e.g. /etc/myShellScript.sh) from Pharo. 5 | 6 | An important part of OSSubprocess is how to manage standard streams (stdin, stdout and stderr) and how to provide an API for reading and writing from them at the language level. 7 | 8 | For more details see: https://github.com/marianopeck/OSSubprocess 9 | " 10 | Class { 11 | #name : #ConfigurationOfOSSubprocess, 12 | #superclass : #ConfigurationOf, 13 | #category : 'ConfigurationOfOSSubprocess' 14 | } 15 | 16 | { #category : #catalog } 17 | ConfigurationOfOSSubprocess class >> catalogChangeLog [ 18 | ^ 'See https://github.com/pharo-contributions/OSSubprocess/blob/master/CHANGELOG.md' 19 | ] 20 | 21 | { #category : #catalog } 22 | ConfigurationOfOSSubprocess class >> catalogContactInfo [ 23 | ^ 'Pharo mailing list' 24 | ] 25 | 26 | { #category : #catalog } 27 | ConfigurationOfOSSubprocess class >> catalogDescription [ 28 | ^ 'OSSubprocess is a software project that allows the user to spawn Operating System processes from within Pharo. The main usage of forking external OS processes is to be able to execute OS commands (e.g. cat, ls, ps, cp, etc) as well as arbitrary shell scripts (e.g. /etc/myShellScript.sh) from Pharo. 29 | 30 | An important part of OSSubprocess is how to manage standard streams (stdin, stdout and stderr) and how to provide an API for reading and writing from them at the language level. 31 | 32 | For more details see: https://github.com/pharo-contributions/OSSubprocess' 33 | ] 34 | 35 | { #category : #catalog } 36 | ConfigurationOfOSSubprocess class >> catalogKeyClassesAndExample [ 37 | ^ ' See https://github.com/pharo-contributions/OSSubprocess/ ' 38 | ] 39 | 40 | { #category : #catalog } 41 | ConfigurationOfOSSubprocess class >> catalogKeywords [ 42 | ^ #(OSProcess forking processes Unix) 43 | ] 44 | 45 | { #category : #'symbolic versions' } 46 | ConfigurationOfOSSubprocess >> stable: spec [ 47 | 48 | 49 | spec for: #'pharo7.x' version: '1.0.0'. 50 | spec for: #'pharo6.x' version: '1.0.0'. 51 | spec for: #'pharo5.x' version: '0.2.5' 52 | ] 53 | 54 | { #category : #versions } 55 | ConfigurationOfOSSubprocess >> v0_1_4: spec [ 56 | 57 | 58 | spec 59 | for: #'common' 60 | do: [ 61 | spec 62 | baseline: 'OSSubprocess' 63 | with: [ spec repository: 'github://pharo-contributions/OSSubprocess:v0.1.4/repository' ]; 64 | import: 'OSSubprocess' ]. 65 | ] 66 | 67 | { #category : #versions } 68 | ConfigurationOfOSSubprocess >> v0_2_0: spec [ 69 | 70 | 71 | spec 72 | for: #'common' 73 | do: [ 74 | spec 75 | baseline: 'OSSubprocess' 76 | with: [ spec repository: 'github://pharo-contributions/OSSubprocess:v0.2.0/repository' ]; 77 | import: 'OSSubprocess' ]. 78 | ] 79 | 80 | { #category : #versions } 81 | ConfigurationOfOSSubprocess >> v0_2_1: spec [ 82 | 83 | 84 | spec 85 | for: #'common' 86 | do: [ 87 | spec 88 | baseline: 'OSSubprocess' 89 | with: [ spec repository: 'github://pharo-contributions/OSSubprocess:v0.2.1/repository' ]; 90 | import: 'OSSubprocess' ]. 91 | ] 92 | 93 | { #category : #versions } 94 | ConfigurationOfOSSubprocess >> v0_2_2: spec [ 95 | 96 | 97 | spec 98 | for: #'common' 99 | do: [ 100 | spec 101 | baseline: 'OSSubprocess' 102 | with: [ spec repository: 'github://pharo-contributions/OSSubprocess:v0.2.2/repository' ]; 103 | import: 'OSSubprocess' ]. 104 | ] 105 | 106 | { #category : #versions } 107 | ConfigurationOfOSSubprocess >> v0_2_3: spec [ 108 | 109 | 110 | spec 111 | for: #'pharo' 112 | do: [ 113 | spec 114 | baseline: 'OSSubprocess' 115 | with: [ spec repository: 'github://pharo-contributions/OSSubprocess:v0.2.3/repository' ]; 116 | import: 'OSSubprocess' ]. 117 | ] 118 | 119 | { #category : #versions } 120 | ConfigurationOfOSSubprocess >> v0_2_4: spec [ 121 | 122 | 123 | spec 124 | for: #'pharo' 125 | do: [ 126 | spec 127 | baseline: 'OSSubprocess' 128 | with: [ spec repository: 'github://pharo-contributions/OSSubprocess:v0.2.4/repository' ]; 129 | import: 'OSSubprocess' ]. 130 | ] 131 | 132 | { #category : #versions } 133 | ConfigurationOfOSSubprocess >> v0_2_5: spec [ 134 | 135 | 136 | spec 137 | for: #'pharo' 138 | do: [ 139 | spec 140 | baseline: 'OSSubprocess' 141 | with: [ spec repository: 'github://pharo-contributions/OSSubprocess:v0.2.5/repository' ]; 142 | import: 'OSSubprocess' ]. 143 | ] 144 | 145 | { #category : #versions } 146 | ConfigurationOfOSSubprocess >> v1_0_0: spec [ 147 | 148 | 149 | spec 150 | for: #'pharo' 151 | do: [ 152 | spec 153 | baseline: 'OSSubprocess' 154 | with: [ spec repository: 'github://pharo-contributions/OSSubprocess:v1.0.0/repository' ]; 155 | import: 'OSSubprocess' ]. 156 | ] 157 | -------------------------------------------------------------------------------- /repository/ConfigurationOfOSSubprocess/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #ConfigurationOfOSSubprocess } 2 | -------------------------------------------------------------------------------- /repository/OSSubprocess-Tests-Stress/OSSConcurrentProcessesTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #OSSConcurrentProcessesTest, 3 | #superclass : #OSSAbstractUnixSubprocessTest, 4 | #category : 'OSSubprocess-Tests-Stress' 5 | } 6 | 7 | { #category : #tests } 8 | OSSConcurrentProcessesTest >> launchAndWaitForProcessesToFinish: numberOfProcesses [ 9 | 10 | "We set the sunit test timeout to 2 times the sleep duration. 11 | Otherwise default sunit test timeout is 1 minute." 12 | 13 | | processes | 14 | "We set the sunit test timeout to 1 second per process. 15 | Except for short running processes, where we keep the default timeout. 16 | This is for Pharo version >= 6.0" 17 | (self respondsTo: #timeLimit:) ifTrue: [ 18 | self timeLimit: (numberOfProcesses seconds max: self defaultTimeLimit). 19 | ]. 20 | 21 | 22 | processes := (1 to: numberOfProcesses) collect: [ :index | 23 | self newCommand 24 | command: '/bin/sleep'; 25 | arguments: { '1s' }; 26 | yourself ]. 27 | 28 | processes do: #run. 29 | 30 | processes do: [ :command | command waitForExitWithTimeout: 5 seconds ] 31 | 32 | ] 33 | 34 | { #category : #tests } 35 | OSSConcurrentProcessesTest >> test100ProcessEventuallyFinishes [ 36 | 37 | self launchAndWaitForProcessesToFinish: 100 38 | ] 39 | 40 | { #category : #tests } 41 | OSSConcurrentProcessesTest >> test10ProcessEventuallyFinishes [ 42 | 43 | self launchAndWaitForProcessesToFinish: 10 44 | ] 45 | 46 | { #category : #tests } 47 | OSSConcurrentProcessesTest >> test1ProcessEventuallyFinishes [ 48 | 49 | self launchAndWaitForProcessesToFinish: 1 50 | ] 51 | -------------------------------------------------------------------------------- /repository/OSSubprocess-Tests-Stress/OSSLongRunningProcessTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #OSSLongRunningProcessTest, 3 | #superclass : #OSSAbstractUnixSubprocessTest, 4 | #category : 'OSSubprocess-Tests-Stress' 5 | } 6 | 7 | { #category : #tests } 8 | OSSLongRunningProcessTest >> doTestProcessEventuallyFinishesForSeconds: aDuration [ 9 | 10 | | command | 11 | "We set the sunit test timeout to 2 times the sleep duration. 12 | Otherwise default sunit test timeout is 1 minute. 13 | This is for Pharo version >= 6.0" 14 | (self respondsTo: #timeLimit:) ifTrue: [ 15 | self timeLimit: aDuration * 2. 16 | ]. 17 | 18 | command := self newCommand 19 | command: '/bin/sleep'; 20 | arguments: { aDuration asSeconds asString }; 21 | yourself. 22 | command run. 23 | 24 | "We should wait and finish without a timeout exception" 25 | command waitForExitWithTimeout: aDuration * 2. 26 | ] 27 | 28 | { #category : #tests } 29 | OSSLongRunningProcessTest >> test100SecondProcessEventuallyFinishes [ 30 | 31 | self doTestProcessEventuallyFinishesForSeconds: 100 second 32 | ] 33 | 34 | { #category : #tests } 35 | OSSLongRunningProcessTest >> test10SecondProcessEventuallyFinishes [ 36 | 37 | self doTestProcessEventuallyFinishesForSeconds: 10 second 38 | ] 39 | 40 | { #category : #tests } 41 | OSSLongRunningProcessTest >> test1SecondProcessEventuallyFinishes [ 42 | 43 | self doTestProcessEventuallyFinishesForSeconds: 1 second 44 | ] 45 | 46 | { #category : #tests } 47 | OSSLongRunningProcessTest >> test300SecondProcessEventuallyFinishes [ 48 | "Wait for five minutes. 49 | Times > 10 minutes make travis timeout." 50 | self doTestProcessEventuallyFinishesForSeconds: 300 second 51 | ] 52 | -------------------------------------------------------------------------------- /repository/OSSubprocess-Tests-Stress/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #'OSSubprocess-Tests-Stress' } 2 | -------------------------------------------------------------------------------- /repository/OSSubprocess-Tests-Unit/OSSAbstractUnixSubprocessTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #OSSAbstractUnixSubprocessTest, 3 | #superclass : #TestCase, 4 | #category : 'OSSubprocess-Tests-Unit' 5 | } 6 | 7 | { #category : #helpers } 8 | OSSAbstractUnixSubprocessTest >> commandClass [ 9 | ^ OSSUnixSubprocess 10 | ] 11 | 12 | { #category : #'instance creation' } 13 | OSSAbstractUnixSubprocessTest >> newCommand [ 14 | 15 | ^ self commandClass new 16 | ] 17 | 18 | { #category : #private } 19 | OSSAbstractUnixSubprocessTest >> systemAccessor [ 20 | ^ OSSVMProcess vmProcess systemAccessor 21 | ] 22 | -------------------------------------------------------------------------------- /repository/OSSubprocess-Tests-Unit/OSSFileBasedUnixSubprocessTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #OSSFileBasedUnixSubprocessTest, 3 | #superclass : #OSSUnixSubprocessTest, 4 | #category : 'OSSubprocess-Tests-Unit' 5 | } 6 | 7 | { #category : #helpers } 8 | OSSFileBasedUnixSubprocessTest >> assertStreamsInfoWithPrevious: beforeArray [ 9 | | afterArray | 10 | afterArray := self getStreamsInfoForRunningTest. 11 | self assert: beforeArray first equals: afterArray first. 12 | self assert: beforeArray second equals: afterArray second. 13 | ] 14 | 15 | { #category : #helpers } 16 | OSSFileBasedUnixSubprocessTest >> getStreamsInfoForRunningTest [ 17 | "We obtain the open tmp files before the open files because in Pharo 7 and ealier getting the entries of /tmp using 18 | 19 | '/tmp' asFileReference entries 20 | 21 | leaves the /tmp file descriptor open. Thus #numberOfOpenFiles, using lsof, detects /tmp as an open file and makes the test fail. 22 | Fixed in Pharo 8." 23 | | openTmpFiles | 24 | openTmpFiles := self numberOfExistingTempStreamFiles. 25 | ^ Array with: self numberOfOpenFiles with: openTmpFiles 26 | ] 27 | 28 | { #category : #helpers } 29 | OSSFileBasedUnixSubprocessTest >> newCommand [ 30 | | command | 31 | command := self commandClass new. 32 | command defaultReadStreamCreationBlock: [ OSSUnixSubprocess createTempFileToBeUsedAsReadStreamOn: '/tmp' ]. 33 | command defaultWriteStreamCreationBlock: [ OSSUnixSubprocess createTempFileToBeUsedAsWriteStreamOn: '/tmp' ]. 34 | ^ command 35 | 36 | ] 37 | 38 | { #category : #helpers } 39 | OSSFileBasedUnixSubprocessTest >> numberOfExistingTempStreamFiles [ 40 | "This answers the number of files that were created for mapping standard files. 41 | Note that in OSSUnixSubprocessTest >> newCommand we define that temp files must be created in /tmp 42 | and in OSSUnixSubprocess >> createTempFilename we can see the format of the name 43 | " 44 | 45 | ^ ('/tmp' asFileReference entries select: [ :each | 46 | (each name beginsWith: 'OSSUnixSubprocess-p') and: [ each name endsWith: '.deleteme' ] ]) size 47 | ] 48 | 49 | { #category : #tests } 50 | OSSFileBasedUnixSubprocessTest >> testBasicCommandWriteToStdin [ 51 | "testBasicCommandWriteToStdin fails because of what the documentation says: 52 | > **Important** We have found some problems when using regular files for the `stdin`. While we do not strictly forbid that, we recommend you do so only if you know very well what you are doing. Otherwise, use blocking pipes for `stdin` (default behavior). 53 | 54 | " 55 | 56 | ] 57 | 58 | { #category : #tests } 59 | OSSFileBasedUnixSubprocessTest >> testReadingFromStdoutAfterCommandFinishesDoesNotBlocksVM [ 60 | 61 | "testReadingFromStdoutAfterCommandFinishesDoesNotBlocksVM fails on Travis on OSX. It looks like if another test would have run while this one was sleeping and hence in #assertStreamsInfoWithPrevious: it fails because there are 2 new not-closed files...which I suspect that those are from another running test..." 62 | Smalltalk platform isMacOS 63 | ifFalse: [ super testReadingFromStdoutAfterCommandFinishesDoesNotBlocksVM ] 64 | 65 | 66 | ] 67 | 68 | { #category : #tests } 69 | OSSFileBasedUnixSubprocessTest >> testReadingFromStdoutDoesNotBlocksVM [ 70 | | command | 71 | "With files, the reading from stdout does not lock the VM" 72 | command := self newCommand 73 | command: '/bin/sleep'; 74 | arguments: (Array with: '4'); 75 | redirectStdout. 76 | 77 | command run. 78 | self assert:[ command stdoutStream upToEnd ] timeToRun seconds <= 1. 79 | command waitForExit. 80 | command closeAndCleanStreams. 81 | ] 82 | 83 | { #category : #'tests - signals' } 84 | OSSFileBasedUnixSubprocessTest >> testSigTerm [ 85 | "Same as super impl but special handling for #assertStreamsInfoWithPrevious:. Read comment at the bottom" 86 | | process exited streamsInfo | 87 | 88 | "We set the sunit test timeout to 2 times the sleep duration. 89 | Otherwise default sunit test timeout is 1 minute. 90 | This is for Pharo version >= 6.0" 91 | (self respondsTo: #timeLimit:) ifTrue: [ 92 | self timeLimit: 30 seconds. 93 | ]. 94 | 95 | exited := false. 96 | streamsInfo := self getStreamsInfoForRunningTest. 97 | process := self newCommand. 98 | [ 99 | process 100 | command: 'tail'; 101 | arguments: (Array with: '-f' with: Smalltalk image changesName); 102 | redirectStdout; 103 | redirectStderr; 104 | runAndWaitPollingEvery: (Delay forMilliseconds: 500) 105 | doing: [ :aProcess :outStream :errStream | 106 | outStream upToEnd. 107 | errStream upToEnd. 108 | ] 109 | onExitDo: [ :aProcess :outStream :errStream | 110 | process closeAndCleanStreams. 111 | exited := true. 112 | self assert: aProcess exitStatusInterpreter printString equals: 'exit due to signal 15' 113 | ]. 114 | "The problem here is that we simply do a #fork this closure will continue to be executed while other test run. And so, all the test checking for zombies or opened files will fail because we can have this forked process that did not yet finish. A workaround is to simply run this closures with a higher priority so that there are less chances of other tests to be running. Another possibility would be to reject those 'tail' processes from #numberOfZombiesProcesses and #numberOfOpenFiles as all the tests that use #fork use the 'tail' OS command." 115 | ] forkAt: Processor userInterruptPriority. 116 | 117 | (Delay forSeconds: 2) wait. 118 | process sigterm. 119 | (Delay forSeconds: 10) wait. 120 | self assert: exited. 121 | [ 122 | "I could never understood why but only with OSSFileBasedUnixSubprocessTest and only on OSX, randomly (when running many tests together) below assertion fails. I cannod add this test as #expectedFailure because sometimes it works and then when it does it is marked as failure becasue it didn't fail. So I simply skip the test if it failed" 123 | self assertStreamsInfoWithPrevious: streamsInfo. 124 | ] on: TestFailure do: [ self skip ] 125 | ] 126 | -------------------------------------------------------------------------------- /repository/OSSubprocess-Tests-Unit/OSSPipeBasedUnixSubprocessTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #OSSPipeBasedUnixSubprocessTest, 3 | #superclass : #OSSUnixSubprocessTest, 4 | #category : 'OSSubprocess-Tests-Unit' 5 | } 6 | 7 | { #category : #helper } 8 | OSSPipeBasedUnixSubprocessTest >> newCommand [ 9 | 10 | ^ self commandClass new 11 | "For pipes, we can use a pipe for both reading or writing" 12 | defaultReadStreamCreationBlock: [self systemAccessor makeBlockingPipe]; 13 | defaultWriteStreamCreationBlock: [self systemAccessor makeNonBlockingPipe]; 14 | yourself 15 | 16 | 17 | ] 18 | 19 | { #category : #'tests - streams' } 20 | OSSPipeBasedUnixSubprocessTest >> testCommandTryToWriteToStdoutButHasNoReader [ 21 | | command errString | 22 | command := self newCommand 23 | shellCommand: 'sleep 2; echo 42'; 24 | redirectStdout; 25 | redirectStderr. 26 | 27 | command run. 28 | command stdoutStream closeReader. 29 | command waitForExit. 30 | "This should be a SIGPIPE because there is no reader opened for the pipe and someone is trying to write to it. " 31 | errString := command stderrStream upToEndOfFile. 32 | self assert: command exitStatusInterpreter exitStatus > 0. "It ended with error". 33 | "Ideally I would also add this assert, but it seems not all OS write this on stderr. For example, 34 | OSX does write it, while Linux does not." 35 | "self assert:( errString includesSubstring: 'Broken pipe')." 36 | command closeAndCleanStreams. 37 | ] 38 | 39 | { #category : #'tests - streams' } 40 | OSSPipeBasedUnixSubprocessTest >> testReadingFromStdoutBlocksVM [ 41 | | command customStream | 42 | customStream := self systemAccessor makeBlockingPipe. 43 | command := self newCommand 44 | command: '/bin/sleep'; 45 | arguments: (Array with: '4'); 46 | redirectStdoutTo: customStream. 47 | 48 | command run. 49 | self assert:[ command stdoutStream upToEnd ] timeToRun seconds > 2. 50 | command waitForExit. 51 | command closeAndCleanStreams. 52 | ] 53 | 54 | { #category : #'tests - streams' } 55 | OSSPipeBasedUnixSubprocessTest >> testReadingFromStdoutDoesNotBlocksVM [ 56 | | command customStream | 57 | customStream := self systemAccessor makeNonBlockingPipe. 58 | command := self newCommand 59 | command: '/bin/sleep'; 60 | arguments: (Array with: '4'); 61 | redirectStdoutTo: customStream. 62 | 63 | command run. 64 | self assert:[ command stdoutStream upToEnd ] timeToRun seconds <= 2. 65 | command waitForExit. 66 | command closeAndCleanStreams. 67 | ] 68 | -------------------------------------------------------------------------------- /repository/OSSubprocess-Tests-Unit/OSSPipeTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #OSSPipeTest, 3 | #superclass : #OSSAbstractUnixSubprocessTest, 4 | #category : 'OSSubprocess-Tests-Unit' 5 | } 6 | 7 | { #category : #private } 8 | OSSPipeTest >> blockingPipe [ 9 | ^ self systemAccessor makeBlockingPipe 10 | 11 | ] 12 | 13 | { #category : #private } 14 | OSSPipeTest >> nonBlockingPipe [ 15 | ^ self systemAccessor makeNonBlockingPipe 16 | 17 | ] 18 | 19 | { #category : #private } 20 | OSSPipeTest >> readFromAndClose: aPipe writingTo: aStream [ 21 | 22 | | s | 23 | [aPipe atEndOfFile] whileFalse: 24 | [s := aPipe next: 10000. 25 | aStream nextPutAll: s asString. 26 | (Delay forMilliseconds: 100) wait]. 27 | (aPipe respondsTo: #reader) ifTrue: [aPipe reader close]. 28 | ^ aStream 29 | 30 | ] 31 | 32 | { #category : #testing } 33 | OSSPipeTest >> testBasicWriteAndRead [ 34 | | pipe string readString | 35 | string := 'this is a testing string'. 36 | pipe := self blockingPipe. 37 | pipe writer nextPutAll: string; flush. 38 | readString := pipe reader next: string size. 39 | self assert: string equals: readString 40 | ] 41 | 42 | { #category : #testing } 43 | OSSPipeTest >> testBlocking [ 44 | 45 | | pipe | 46 | pipe := self blockingPipe. 47 | (1 to: 10) do: [:i | pipe nextPutAll: 'this is line ', i printString; cr]. 48 | pipe flush. "protect against buggy clib that may never flush output" 49 | self should: ['this is line 1*' match: (pipe next: 15)]. 50 | self should: ['this is line 2*' match: (pipe next: 15)]. 51 | self should: ['this is line 3*' match: (pipe next: 15)]. 52 | self should: ['this is line 4*' match: (pipe next: 15)]. 53 | self should: ['this is line 5*' match: (pipe next: 15)]. 54 | self should: ['this is line 6*' match: (pipe next: 15)]. 55 | self should: ['this is line 7*' match: (pipe next: 15)]. 56 | self should: ['this is line 8*' match: (pipe next: 15)]. 57 | self should: ['this is line 9*' match: (pipe next: 15)]. 58 | pipe writer close. 59 | self shouldnt: pipe atEnd. 60 | self should: ['this is line 10*' match: (pipe next: 16)]. 61 | self should: pipe atEnd. 62 | pipe close 63 | 64 | ] 65 | 66 | { #category : #testing } 67 | OSSPipeTest >> testBlockingPeek [ 68 | 69 | | pipe | 70 | pipe := self blockingPipe. 71 | pipe nextPutAll: 'abc'. 72 | pipe flush. "protect against buggy clib that may never flush output" 73 | self assert: (pipe peek == $a). 74 | self assert: (pipe next == $a). 75 | self assert: (pipe peek == $b). 76 | self assert: (pipe next == $b). 77 | self assert: (pipe peek == $c). 78 | self deny: pipe atEnd. 79 | self assert: (pipe next == $c). 80 | self deny: pipe atEnd. 81 | pipe closeWriter. 82 | self assert: pipe atEnd. 83 | pipe close 84 | 85 | ] 86 | 87 | { #category : #testing } 88 | OSSPipeTest >> testIsAtEndOfFile [ 89 | 90 | | pipe | 91 | pipe := self nonBlockingPipe. 92 | 93 | self deny: (pipe reader atEndOfFile). 94 | self deny: pipe reader atEnd. 95 | self deny: pipe atEnd. 96 | self assert: (pipe reader basicNext == nil). 97 | self deny: (pipe reader atEndOfFile). 98 | self deny: pipe reader atEnd. 99 | self deny: pipe atEnd. 100 | pipe writer nextPut: $X; flush. 101 | self assert: (pipe reader basicNext == $X). 102 | self deny: (pipe reader atEndOfFile). 103 | self deny: pipe reader atEnd. 104 | self deny: pipe atEnd. 105 | self assert: (pipe reader basicNext == nil). 106 | self deny: (pipe reader atEndOfFile). 107 | self deny: pipe reader atEnd. 108 | self deny: pipe atEnd. 109 | 110 | pipe writer close. 111 | self deny: (pipe reader atEndOfFile). 112 | self deny: pipe atEndOfFile. "no read yet, so flag has not been set" 113 | 114 | "From Pharo 7 on, #atEnd does detect EOF on a pipe" 115 | SystemVersion current major >= 7 116 | ifTrue: [ self assert: pipe reader atEnd ]. 117 | 118 | self assert: pipe atEnd. "writer closed and read gives nil" 119 | 120 | self assert: (pipe reader basicNext == nil). "read operation should set flag" 121 | self assert: (pipe reader atEndOfFile). 122 | 123 | "From Pharo 7 on, #atEnd does detect EOF on a pipe" 124 | SystemVersion current major >= 7 125 | ifTrue: [ self assert: pipe reader atEnd ]. 126 | 127 | self assert: pipe reader atEndOfFile. 128 | self assert: pipe atEnd. 129 | pipe close 130 | 131 | ] 132 | 133 | { #category : #testing } 134 | OSSPipeTest >> testIsAtEndOfFile2 [ 135 | 136 | | pipe string | 137 | pipe := self nonBlockingPipe. 138 | [pipe nextPutAll: 'hello'; flush. 139 | string := pipe next: 100. 140 | self assert: string = 'hello'. 141 | self deny: pipe atEndOfFile. 142 | pipe closeWriter. 143 | self deny: pipe atEndOfFile. 144 | string := pipe next: 100. 145 | self assert: string = ''. 146 | self assert: pipe atEndOfFile] 147 | ensure: [pipe close] 148 | 149 | ] 150 | 151 | { #category : #testing } 152 | OSSPipeTest >> testNonBlocking [ 153 | 154 | | pipe writeStream string | 155 | pipe := self nonBlockingPipe. 156 | self writeStuffOnThenClose: pipe. 157 | writeStream := self readFromAndClose: pipe writingTo: (WriteStream on: String new). 158 | string := (writeStream contents last: 16). 159 | self should: ['this is line 10*' match: string]. 160 | pipe close 161 | 162 | ] 163 | 164 | { #category : #testing } 165 | OSSPipeTest >> testNonBlockingPeek [ 166 | 167 | | pipe | 168 | pipe := self nonBlockingPipe. 169 | pipe nextPutAll: 'abc'; flush. 170 | self assert: (pipe peek == $a). 171 | self assert: (pipe next == $a). 172 | self assert: (pipe peek == $b). 173 | self assert: (pipe next == $b). 174 | self assert: (pipe peek == $c). 175 | self deny: pipe atEnd. 176 | self assert: (pipe next == $c). 177 | self deny: pipe atEnd. 178 | pipe closeWriter. 179 | self assert: pipe atEnd. 180 | pipe close 181 | 182 | ] 183 | 184 | { #category : #testing } 185 | OSSPipeTest >> testReadAfterClosedReadEnd [ 186 | | pipe writeStream readStream string | 187 | string := 'this is a testing string'. 188 | pipe := self blockingPipe. 189 | pipe writer nextPutAll: string; flush. 190 | readStream := pipe reader. 191 | pipe closeReader. 192 | self assert: readStream closed. 193 | self should: [ readStream upToEndOfFile ] raise: Error. 194 | self should: [ readStream upToEnd ] raise: Error. 195 | 196 | ] 197 | 198 | { #category : #testing } 199 | OSSPipeTest >> testWriteAfterClosedWriteEnd [ 200 | | pipe writeStream string | 201 | string := 'this is a testing string'. 202 | pipe := self blockingPipe. 203 | pipe closeWriter. 204 | self should: [ pipe writer nextPutAll: string; flush ] raise: Error. 205 | 206 | ] 207 | 208 | { #category : #private } 209 | OSSPipeTest >> writeStuffOnThenClose: aPipe [ 210 | 211 | ^ [(1 to: 10) do: 212 | [:i | 213 | [aPipe nextPutAll: 'this is line ', i printString; cr] 214 | on: Error 215 | do: ["Ignore error. Test case will still fail, and throwing an error in this 216 | process would cause a debugger to be scheduled inconveniently."]. 217 | (Delay forMilliseconds: 50) wait]. 218 | (aPipe respondsTo: #writer) 219 | ifTrue: [[aPipe writer close] 220 | on: Error 221 | do: ["Ignore error to avoid a debugger"]] 222 | ifFalse: [[aPipe close] 223 | on: Error 224 | do: ["Ignore error to avoid a debugger"]]] 225 | forkAt: Processor userBackgroundPriority 226 | ] 227 | -------------------------------------------------------------------------------- /repository/OSSubprocess-Tests-Unit/OSSUnixSubprocessTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #OSSUnixSubprocessTest, 3 | #superclass : #OSSAbstractUnixSubprocessTest, 4 | #category : 'OSSubprocess-Tests-Unit' 5 | } 6 | 7 | { #category : #testing } 8 | OSSUnixSubprocessTest class >> isAbstract [ 9 | "Override to true if a TestCase subclass is Abstract and should not have 10 | TestCase instances built from it" 11 | 12 | ^self name = #OSSUnixSubprocessTest 13 | 14 | ] 15 | 16 | { #category : #helpers } 17 | OSSUnixSubprocessTest >> assertStreamsInfoWithPrevious: anObject [ 18 | self assert: self getStreamsInfoForRunningTest equals: anObject 19 | ] 20 | 21 | { #category : #helpers } 22 | OSSUnixSubprocessTest >> getStreamsInfoForRunningTest [ 23 | ^ self numberOfOpenFiles 24 | ] 25 | 26 | { #category : #helpers } 27 | OSSUnixSubprocessTest >> numberOfOpenFiles [ 28 | "This is estimation number. Not to be used for real code. It's basically to check the number of opened FIFO files at the beginning of a test and at the end, to validate we are not leaving behind opened files. 29 | This should work in most Unix-like and Linux systems. 30 | Only FIFO files are checked as we can't control other threads, and it is redirecting stdio that is happening in the tests." 31 | | tmpFileName openFiles | 32 | tmpFileName := (FileSystem workingDirectory / 'openFilesByPharoVM-' , UUID new printString) fullName. 33 | tmpFileName asFileReference ensureDelete. 34 | self systemAccessor system: ('lsof -p ', OSSVMProcess vmProcess pid printString, ' > "', tmpFileName, '" 2>&1'). 35 | openFiles := tmpFileName asFileReference readStreamDo: [ :str | | lines | 36 | lines := str contents lines. 37 | "Count only pipes" 38 | lines select: [ :each | each includesSubstring: 'FIFO' ] 39 | ]. 40 | tmpFileName asFileReference ensureDelete. 41 | ^ openFiles size 42 | 43 | ] 44 | 45 | { #category : #helpers } 46 | OSSUnixSubprocessTest >> numberOfZombiesProcesses [ 47 | "This is estimation number. Not to be used for real code. IT's basically 48 | to check the number of zombies at the beginning of a test and at the end, to validate we are not leaving behind new zombies. 49 | This should work in most Unix-like and Linux 50 | " 51 | | tmpFileName zombiesCount | 52 | tmpFileName := (FileSystem workingDirectory / 'zombiesByPharoVM-' , UUID new printString) fullName. 53 | tmpFileName asFileReference ensureDelete. 54 | self systemAccessor system: ('ps axo ppid=,stat= | grep ', OSSVMProcess vmProcess pid printString, ' | awk ''$2~/^Z/ { print $2 }'' | wc -l > "', tmpFileName, '" 2>&1'). 55 | zombiesCount := tmpFileName asFileReference readStreamDo: [ :str | 56 | str contents trimmed asNumber 57 | ]. 58 | tmpFileName asFileReference ensureDelete. 59 | ^ zombiesCount 60 | 61 | ] 62 | 63 | { #category : #helpers } 64 | OSSUnixSubprocessTest >> ppidOf: childPid [ 65 | "Answers the parent pid (ppid) of the childPid 66 | " 67 | | tmpFileName openFilesNumber | 68 | tmpFileName := (FileSystem workingDirectory / ' ppidof-' , UUID new printString) fullName. 69 | tmpFileName asFileReference ensureDelete. 70 | Transcript show: tmpFileName; cr. 71 | self systemAccessor system: ('ps -p ', childPid , ' -o ppid='). 72 | openFilesNumber := tmpFileName asFileReference readStreamDo: [ :str | 73 | "The -1 is because the above command brings one line which is a header." 74 | str contents trimmed asNumber 75 | ]. 76 | tmpFileName asFileReference ensureDelete. 77 | ^ openFilesNumber 78 | 79 | ] 80 | 81 | { #category : #'tests - env' } 82 | OSSUnixSubprocessTest >> testAddAllEnvVariablesFromParent [ 83 | | command | 84 | command := self newCommand 85 | command: '/bin/ls'; 86 | environmentAt: 'WHATEVER' put: 'vi'; 87 | addAllEnvVariablesFromParentWithoutOverride. 88 | 89 | self assert: command envVariables size equals: (OSSUnixSubprocess new defaultEnvVariablesDictionary keys size) + 1. 90 | 91 | 92 | 93 | ] 94 | 95 | { #category : #'tests - env' } 96 | OSSUnixSubprocessTest >> testAddAllEnvVariablesFromParentWithoutOverride [ 97 | | command | 98 | "Here we assume that the parent process will have the $PATH defined." 99 | command := self newCommand 100 | command: '/bin/ls'; 101 | environmentAt: 'PATH' put: 'whatever'; 102 | addAllEnvVariablesFromParentWithoutOverride. 103 | 104 | self assert: command envVariables size equals: (OSSUnixSubprocess new defaultEnvVariablesDictionary keys size). 105 | self assert: (command envVariables at: 'PATH') equals: 'whatever' 106 | 107 | 108 | 109 | ] 110 | 111 | { #category : #'tests - env' } 112 | OSSUnixSubprocessTest >> testAddOnlyOneVariable [ 113 | | command | 114 | command := self newCommand 115 | command: '/bin/ls'; 116 | environmentAt: 'EDITOR' put: 'vi'. 117 | 118 | self assert: command envVariables size equals: 1. 119 | 120 | 121 | 122 | ] 123 | 124 | { #category : #'tests - basic' } 125 | OSSUnixSubprocessTest >> testBasicCommand [ 126 | | command | 127 | command := self newCommand 128 | command: '/bin/ls'. 129 | command runAndWait. 130 | 131 | ] 132 | 133 | { #category : #'tests - streams' } 134 | OSSUnixSubprocessTest >> testBasicCommandReadFromStderr [ 135 | | streamsInfo | 136 | streamsInfo := self getStreamsInfoForRunningTest. 137 | self newCommand 138 | command: '/bin/ls'; 139 | arguments: (Array with: '-' with: 'foo'); 140 | redirectStderr; 141 | runAndWaitOnExitDo: [ :command :outString :errString | 142 | self assert: (errString includesSubstring: ': No such file or directory'). 143 | self assert: command stdoutStream isNil. 144 | self assert: command stderrStream closed. 145 | self assertStreamsInfoWithPrevious: streamsInfo. 146 | ]. 147 | 148 | 149 | ] 150 | 151 | { #category : #'tests - streams' } 152 | OSSUnixSubprocessTest >> testBasicCommandReadFromStdout [ 153 | | streamsInfo | 154 | streamsInfo := self getStreamsInfoForRunningTest. 155 | self newCommand 156 | command: '/bin/ls'; 157 | arguments: (Array with: Smalltalk image imagePath); 158 | redirectStdout; 159 | runAndWaitOnExitDo: [ :command :outString | 160 | self assert: (outString includesSubstring: Smalltalk image imagePath). 161 | self assertStreamsInfoWithPrevious: streamsInfo. 162 | ]. 163 | 164 | 165 | ] 166 | 167 | { #category : #'tests - basic' } 168 | OSSUnixSubprocessTest >> testBasicCommandWithArgument [ 169 | | command | 170 | 171 | command := self newCommand 172 | command: '/bin/ls'; 173 | arguments: { Smalltalk image imagePath. }. 174 | 175 | command runAndWait 176 | ] 177 | 178 | { #category : #'tests - basic' } 179 | OSSUnixSubprocessTest >> testBasicCommandWithNonAsciiArgument [ 180 | | command | 181 | 182 | self withNonAsciiDirectoryDo: [ :dir | 183 | command := self newCommand 184 | command: '/bin/ls'; 185 | arguments: { dir fullName }. 186 | command runAndWait 187 | ] 188 | 189 | ] 190 | 191 | { #category : #'tests - basic' } 192 | OSSUnixSubprocessTest >> testBasicCommandWithoutFullPath [ 193 | 194 | self newCommand 195 | command: 'ls'; 196 | arguments: (Array with: Smalltalk image imagePath); 197 | redirectStdout; 198 | runAndWaitOnExitDo: [ :command :outString | 199 | self assert: (outString includesSubstring: Smalltalk image imagePath). 200 | ] 201 | 202 | 203 | ] 204 | 205 | { #category : #'tests - streams' } 206 | OSSUnixSubprocessTest >> testBasicCommandWriteToStdin [ 207 | | command stdOutString string streamsInfo | 208 | streamsInfo := self getStreamsInfoForRunningTest. 209 | string := 'this is a test shat should have been printed in the stdout'. 210 | command := self newCommand 211 | command: '/bin/cat'; 212 | redirectStdin; 213 | redirectStdout. 214 | 215 | command run. 216 | command stdinStream 217 | nextPutAll: string; 218 | close. 219 | command waitForExit. 220 | stdOutString := command stdoutStream upToEndOfFile. 221 | command closeAndCleanStreams. 222 | self assert: command isSuccess. 223 | self assert: stdOutString equals: string. 224 | self assertStreamsInfoWithPrevious: streamsInfo. 225 | 226 | 227 | 228 | ] 229 | 230 | { #category : #'tests - streams' } 231 | OSSUnixSubprocessTest >> testBasicCommandWriteToStdin2 [ 232 | | command streamsInfo outString | 233 | streamsInfo := self getStreamsInfoForRunningTest. 234 | 235 | command := self newCommand 236 | command: 'wc'; 237 | redirectStdin; 238 | redirectStdout; 239 | run. 240 | 241 | command stdinStream 242 | nextPutAll: Smalltalk image imagePath; 243 | close. 244 | 245 | command waitForExit. 246 | outString := command stdoutStream upToEndOfFile. 247 | command closeAndCleanStreams. 248 | self assert: command isSuccess. 249 | "It's hard to test the output of wc crossplatform..." 250 | self assert: outString size > 5. 251 | self assertStreamsInfoWithPrevious: streamsInfo. 252 | 253 | 254 | 255 | ] 256 | 257 | { #category : #'tests - shell' } 258 | OSSUnixSubprocessTest >> testBasicShellCommand [ 259 | | command | 260 | 261 | command := self newCommand 262 | shellCommand: 'ls'. 263 | 264 | command runAndWait. 265 | 266 | ] 267 | 268 | { #category : #'tests - shell' } 269 | OSSUnixSubprocessTest >> testBasicShellCommandWithNonAsciiCharacters [ 270 | 271 | self withNonAsciiDirectoryDo: [ :dir | 272 | (dir / 'ok.txt') ensureCreateFile. 273 | self newCommand 274 | shellCommand: 'ls ', dir fullName; 275 | redirectStdout; 276 | runAndWaitOnExitDo: [ :command :outString | 277 | self assert: (outString includesSubstring: 'ok.txt'). 278 | ] 279 | ] 280 | ] 281 | 282 | { #category : #'tests - shell' } 283 | OSSUnixSubprocessTest >> testBasicShellCommandWithStdout [ 284 | 285 | self newCommand 286 | shellCommand: 'ls "', Smalltalk image imagePath, '"'; 287 | redirectStdout; 288 | runAndWaitOnExitDo: [ :command :outString | 289 | self assert: (outString includesSubstring: Smalltalk image imagePath). 290 | ] 291 | 292 | 293 | ] 294 | 295 | { #category : #'tests - child status' } 296 | OSSUnixSubprocessTest >> testCheckZombieStateAndTestChildWatcherWorking [ 297 | | command oldZombies | 298 | oldZombies := self numberOfZombiesProcesses. 299 | command := self newCommand 300 | command: '/bin/sleep'; 301 | arguments: {'1'}. 302 | 303 | command run. 304 | self assert: command pid > 0. 305 | (Duration seconds: 2) wait. 306 | "In this case we are NOT going to do the queryExitStatus since we want to know 307 | if the child watcher is doing it's job." 308 | "self assert: command queryExitStatus isNil not." 309 | "Now it should not be a zombie anymore" 310 | self assert: self numberOfZombiesProcesses equals: oldZombies. 311 | 312 | 313 | ] 314 | 315 | { #category : #'tests - child status' } 316 | OSSUnixSubprocessTest >> testCheckZombieStateWithNonExistingCommang [ 317 | | command oldZombies | 318 | oldZombies := self numberOfZombiesProcesses. 319 | command := self newCommand 320 | command: 'whatever'. 321 | 322 | "Ideally, I would like to use a should:raise: but not all OS do fail. OSX does send errorl, while Linux does not. 323 | So...if error, then it;s ok. But if not, also." 324 | [ command runAndWait ] on: Error do: [ :ex | 325 | self assert: (ex printString includesSubstring: 'No such file or directory') . 326 | self assert: command pid isNil. 327 | ^ nil 328 | ]. 329 | 330 | self assert: command exitStatusInterpreter exitStatus > 0. 331 | self assert: self numberOfZombiesProcesses equals: oldZombies. 332 | 333 | 334 | ] 335 | 336 | { #category : #'tests - child status' } 337 | OSSUnixSubprocessTest >> testCheckZombieStateWithOnExitApi [ 338 | | command oldZombies | 339 | oldZombies := self numberOfZombiesProcesses. 340 | command := self newCommand 341 | command: '/bin/sleep'; 342 | arguments: {'1'}; 343 | runAndWaitOnExitDo: [ ]. 344 | 345 | self assert: self numberOfZombiesProcesses equals: oldZombies. 346 | 347 | 348 | ] 349 | 350 | { #category : #'tests - child status' } 351 | OSSUnixSubprocessTest >> testCheckZombieStateWithWaitChild [ 352 | | command oldZombies | 353 | oldZombies := self numberOfZombiesProcesses. 354 | command := self newCommand 355 | command: '/bin/sleep'; 356 | arguments: {'1'}. 357 | 358 | command run. 359 | command waitForExit. 360 | self assert: self numberOfZombiesProcesses equals: oldZombies. 361 | 362 | 363 | ] 364 | 365 | { #category : #'tests - wait' } 366 | OSSUnixSubprocessTest >> testCommandReturningDifferentThanZero [ 367 | | command | 368 | 369 | "When the file does not exists ls returns 1" 370 | command := self newCommand 371 | command: '/bin/ls'; 372 | arguments: {'asdasdasdasdsad'}. 373 | 374 | command runAndWait. 375 | 376 | "Do not use #deny:equals: for Pharo 6 compatibility" 377 | self deny: (command exitStatusInterpreter exitStatus = 0) 378 | ] 379 | 380 | { #category : #'tests - streams' } 381 | OSSUnixSubprocessTest >> testCreateMissingStandardStreamsDisabled [ 382 | | command | 383 | 384 | command := self newCommand 385 | command: '/bin/ls'. 386 | 387 | command runAndWait. 388 | self assert: command stdinStream isNil. 389 | self assert: command stdoutStream isNil. 390 | self assert: command stderrStream isNil. 391 | 392 | ] 393 | 394 | { #category : #'tests - streams' } 395 | OSSUnixSubprocessTest >> testCreateMissingStandardStreamsEnabled [ 396 | | command streamsInfo | 397 | streamsInfo := self getStreamsInfoForRunningTest. 398 | "The output of the ls command should be displayed in the stdout of the Pharo image. See comment of #createPipesForMissingStreams: for more details" 399 | command := self newCommand 400 | command: '/bin/ls'; 401 | createMissingStandardStreams: true. 402 | 403 | command runAndWait. 404 | self assert: command stdinStream isNil not. 405 | self assert: command stdoutStream isNil not. 406 | self assert: command stderrStream isNil not. 407 | command closeAndCleanStreams. 408 | self assertStreamsInfoWithPrevious: streamsInfo. 409 | 410 | ] 411 | 412 | { #category : #'tests - shell' } 413 | OSSUnixSubprocessTest >> testCustomShellWithStdout [ 414 | 415 | self newCommand 416 | shell: '/bin/bash' command: 'ls "', Smalltalk image imagePath, '"'; 417 | redirectStdout; 418 | runAndWaitOnExitDo: [ :command :outString | 419 | self assert: (outString includesSubstring: Smalltalk image imagePath). 420 | ] 421 | 422 | 423 | ] 424 | 425 | { #category : #'tests - streams' } 426 | OSSUnixSubprocessTest >> testCustomStdoutStream [ 427 | | customStream streamsInfo | 428 | streamsInfo := self getStreamsInfoForRunningTest. 429 | customStream := self newCommand createADefaultWriteStream. 430 | self newCommand 431 | command: '/bin/ls'; 432 | arguments: (Array with: Smalltalk image imagePath); 433 | redirectStdoutTo: customStream; 434 | runAndWaitOnExitDo: [ :command :outString | 435 | self assert: (outString includesSubstring: Smalltalk image imagePath). 436 | self assert: command stdoutStream == customStream . 437 | self assertStreamsInfoWithPrevious: streamsInfo. 438 | ]. 439 | 440 | 441 | 442 | 443 | ] 444 | 445 | { #category : #'tests - child status' } 446 | OSSUnixSubprocessTest >> testGetChildPid [ 447 | | command | 448 | 449 | command := self newCommand 450 | command: '/bin/ls'. 451 | 452 | command run. 453 | self assert: command pid > 0. 454 | command waitForExit. 455 | ] 456 | 457 | { #category : #'tests - child status' } 458 | OSSUnixSubprocessTest >> testGetChildStatusAfterFailingCommand [ 459 | | command oldZombies | 460 | oldZombies := self numberOfZombiesProcesses. 461 | command := self newCommand 462 | command: '/bin/ls'; 463 | arguments: {'whatever'}. 464 | command run. 465 | self assert: command pid > 0. 466 | command waitForExit. 467 | command queryExitStatus. 468 | self assert: command exitStatusInterpreter exitStatus > 0. 469 | self deny: command isSuccess. 470 | self assert: command isComplete. 471 | self deny: command isRunning. 472 | self assert: self numberOfZombiesProcesses equals: oldZombies. 473 | ] 474 | 475 | { #category : #'tests - child status' } 476 | OSSUnixSubprocessTest >> testGetChildStatusAfterFinishesMultipleTimes [ 477 | | command oldZombies | 478 | oldZombies := self numberOfZombiesProcesses. 479 | command := self newCommand 480 | command: '/bin/ls'. 481 | 482 | command run. 483 | self assert: command pid > 0. 484 | command waitForExit. 485 | "Just wanted to be sure there is no problem calling waitpid() multiple times" 486 | command queryExitStatus. 487 | command queryExitStatus. 488 | command queryExitStatus. 489 | command queryExitStatus. 490 | 491 | self assert: command exitStatusInterpreter exitStatus equals: 0. 492 | self assert: command isSuccess. 493 | self assert: command isComplete. 494 | self deny: command isRunning. 495 | self assert: self numberOfZombiesProcesses equals: oldZombies. 496 | ] 497 | 498 | { #category : #'tests - child status' } 499 | OSSUnixSubprocessTest >> testGetChildStatusAfterFinishesSuccess [ 500 | | command oldZombies | 501 | oldZombies := self numberOfZombiesProcesses. 502 | command := self newCommand 503 | command: '/bin/ls'. 504 | 505 | command run. 506 | self assert: command pid > 0. 507 | command waitForExit. 508 | command queryExitStatus. 509 | self assert: command exitStatusInterpreter exitStatus equals: 0. 510 | self assert: command isSuccess. 511 | self assert: command isComplete. 512 | self deny: command isRunning. 513 | self assert: self numberOfZombiesProcesses equals: oldZombies. 514 | ] 515 | 516 | { #category : #'tests - child status' } 517 | OSSUnixSubprocessTest >> testGetChildStatusBeforeAndAfterFinishing [ 518 | | command oldZombies | 519 | oldZombies := self numberOfZombiesProcesses. 520 | command := self newCommand 521 | command: '/bin/sleep'; 522 | arguments: {'3'}. 523 | 524 | command run. 525 | self assert: command pid > 0. 526 | (Duration seconds: 1) wait. 527 | self assert: command queryExitStatus isNil. 528 | self deny: command isComplete. 529 | self assert: command isRunning. 530 | command waitForExit. 531 | self assert: command queryExitStatus isNil not. 532 | self assert: command exitStatusInterpreter exitStatus equals: 0. 533 | self assert: command isComplete. 534 | self assert: self numberOfZombiesProcesses equals: oldZombies. 535 | 536 | ] 537 | 538 | { #category : #'tests - env' } 539 | OSSUnixSubprocessTest >> testInheritVarFromEnv [ 540 | | command | 541 | command := self newCommand 542 | shellCommand: 'echo ${HOME} 2>&1 > /tmp/testReadUserDefinedEnvVar '; 543 | runAndWait. 544 | 545 | self assert: ('/tmp/testReadUserDefinedEnvVar' asFileReference readStreamDo: [ :str | str contents ]) trimmed equals: (Smalltalk os environment at: 'HOME') trimmed. 546 | '/tmp/testReadUserDefinedEnvVar' asFileReference ensureDelete. 547 | ] 548 | 549 | { #category : #'tests - basic' } 550 | OSSUnixSubprocessTest >> testNoneExistingCommand [ 551 | | command stdout stderr | 552 | 553 | command := self newCommand 554 | command: 'whatever'; 555 | redirectStdout; 556 | redirectStderr. 557 | 558 | "Ideally, I would like to use a should:raise: but not all OS do fail. OSX does send errorl, while Linux does not. 559 | So...if error, then it;s ok. But if not, also." 560 | [ command runAndWait ] on: Error do: [ :ex | 561 | self assert: (ex printString includesSubstring: 'No such file or directory') . 562 | self assert: command pid isNil. 563 | command closeAndCleanStreams. 564 | ^ nil 565 | ]. 566 | 567 | self assert: command exitStatusInterpreter exitStatus > 0. 568 | command closeAndCleanStreams. 569 | ] 570 | 571 | { #category : #'tests - streams' } 572 | OSSUnixSubprocessTest >> testReadingFromStdoutAfterCommandFinishesDoesNotBlocksVM [ 573 | | command streamsInfo | 574 | 575 | "We set the sunit test timeout to 30 seconds. 576 | Otherwise default sunit test timeout is 10 seconds. 577 | This is for Pharo version >= 6.0" 578 | (self respondsTo: #timeLimit:) ifTrue: [ 579 | self timeLimit: 30 seconds. 580 | ]. 581 | 582 | streamsInfo := self getStreamsInfoForRunningTest. 583 | command := self newCommand 584 | command: '/bin/sleep'; 585 | arguments: (Array with: '1'); 586 | redirectStdout; 587 | runAndWait. 588 | 589 | "Even with a blocking stream, if the command has finished, we have 590 | all data ready to read and hence it's not blocking" 591 | self assert:[ command stdoutStream upToEndOfFile ] timeToRun seconds <= 5. 592 | command closeAndCleanStreams. 593 | self assertStreamsInfoWithPrevious: streamsInfo. 594 | 595 | 596 | 597 | ] 598 | 599 | { #category : #'tests - wait' } 600 | OSSUnixSubprocessTest >> testRunAndWaitPollingEveryRetrievingStreamsOnExitDo [ 601 | self newCommand 602 | command: '/bin/ls'; 603 | arguments: (Array with: Smalltalk image imagePath); 604 | redirectStdout; 605 | runAndWaitPollingEvery: (Delay forMilliseconds: 50) retrievingStreams: true onExitDo: [ :command :outString :errString | 606 | self assert: command pid > 0. 607 | self assert: command exitStatusInterpreter exitStatus equals: 0. 608 | self assert: (outString includesSubstring: Smalltalk image imagePath). 609 | self assert: command stdoutStream closed. 610 | ] 611 | 612 | ] 613 | 614 | { #category : #'tests - env' } 615 | OSSUnixSubprocessTest >> testSetAndReadCustomVariable [ 616 | self newCommand 617 | shellCommand: 'echo ${WHATEVER}'; 618 | environmentAt: 'WHATEVER' put: 'hello'; 619 | redirectStdout; 620 | runAndWaitOnExitDo: [ :command :outString | 621 | self assert: outString trimmed equals: 'hello' 622 | ] 623 | 624 | ] 625 | 626 | { #category : #'tests - env' } 627 | OSSUnixSubprocessTest >> testSetAndReadCustomVariableOutsideShell [ 628 | self newCommand 629 | command: 'printenv'; 630 | arguments: (Array with: 'WHATEVER'); 631 | environmentAt: 'WHATEVER' put: 'hello'; 632 | redirectStdout; 633 | runAndWaitOnExitDo: [ :command :outString | 634 | self assert: outString trimmed equals: 'hello'. 635 | ] 636 | 637 | ] 638 | 639 | { #category : #'tests - env' } 640 | OSSUnixSubprocessTest >> testSetCustomVariableOutsideShellAndPassedToCommand [ 641 | " This test demonstrates that we do not expand variables automatically. So if you don't use the shell, or any other special command that 642 | will search for special variables (like git searching $GIT_EDITOR), these will not be resolved. 643 | If you want that, then you must execute the command with the arguments already expandaded. That is, for example, 644 | in this case, you should pass the argument 'hello' rather than ${WHATEVER} " 645 | 646 | self newCommand 647 | command: '/bin/echo'; 648 | arguments: (Array with: '${WHATEVER}'); 649 | environmentAt: 'WHATEVER' put: 'hello'; 650 | redirectStdout; 651 | runAndWaitOnExitDo: [ :command :outString | 652 | self assert: outString trimmed equals: '${WHATEVER}'. 653 | ] 654 | 655 | ] 656 | 657 | { #category : #'tests - wait' } 658 | OSSUnixSubprocessTest >> testShellCommandReturningDifferentThanZero [ 659 | | command | 660 | 661 | command := self newCommand shellCommand: 'exit 2'. 662 | command runAndWait. 663 | 664 | self assert: command exitStatusInterpreter exitStatus equals: 2. 665 | ] 666 | 667 | { #category : #'tests - shell' } 668 | OSSUnixSubprocessTest >> testShellCommandWithPipingStdout [ 669 | 670 | self newCommand 671 | shellCommand: 'ps -fea | grep Pharo'; 672 | redirectStdout; 673 | runAndWaitOnExitDo: [ :command :outString | 674 | self assert: (outString includesSubstring: 'Pharo'). 675 | ] 676 | 677 | 678 | ] 679 | 680 | { #category : #'tests - shell' } 681 | OSSUnixSubprocessTest >> testShellCommandWithStreamRedirects [ 682 | | stdOutContents | 683 | 684 | self newCommand 685 | shellCommand: 'ps -fea | grep Pharo > /tmp/testShellCommandWithStreamRedirects.deleteme'; 686 | redirectStdout; 687 | runAndWaitOnExitDo: [ :command :outString | 688 | self assert: outString isEmpty. 689 | stdOutContents := '/tmp/testShellCommandWithStreamRedirects.deleteme' asFileReference readStreamDo: [ :str | str contents ] . 690 | self assert: (stdOutContents includesSubstring: 'Pharo'). 691 | ]. 692 | '/tmp/testShellCommandWithStreamRedirects.deleteme' asFileReference ensureDelete. 693 | 694 | 695 | 696 | 697 | ] 698 | 699 | { #category : #'tests - signals' } 700 | OSSUnixSubprocessTest >> testSigTerm [ 701 | 702 | | process exited streamsInfo | 703 | 704 | "We set the sunit test timeout to 30 seconds. 705 | Otherwise default sunit test timeout is 10 seconds. 706 | This is for Pharo version >= 6.0" 707 | (self respondsTo: #timeLimit:) ifTrue: [ 708 | self timeLimit: 30 seconds. 709 | ]. 710 | 711 | exited := false. 712 | streamsInfo := self getStreamsInfoForRunningTest. 713 | process := self newCommand. 714 | [ 715 | process 716 | command: 'tail'; 717 | arguments: (Array with: '-f' with: Smalltalk image changesName); 718 | redirectStdout; 719 | redirectStderr; 720 | runAndWaitPollingEvery: (Delay forMilliseconds: 500) 721 | doing: [ :aProcess :outStream :errStream | 722 | outStream upToEnd. 723 | errStream upToEnd. 724 | ] 725 | onExitDo: [ :aProcess :outStream :errStream | 726 | process closeAndCleanStreams. 727 | exited := true. 728 | self assert: aProcess exitStatusInterpreter printString equals: 'exit due to signal 15' 729 | ]. 730 | "The problem here is that we simply do a #fork this closure will continue to be executed while other test run. And so, all the test checking for zombies or opened files will fail because we can have this forked process that did not yet finish. A workaround is to simply run this closures with a higher priority so that there are less chances of other tests to be running. Another possibility would be to reject those 'tail' processes from #numberOfZombiesProcesses and #numberOfOpenFiles as all the tests that use #fork use the 'tail' OS command." 731 | ] forkAt: Processor userInterruptPriority. 732 | 733 | (Delay forSeconds: 2) wait. 734 | process sigterm. 735 | (Delay forSeconds: 10) wait. 736 | self assert: exited. 737 | self assertStreamsInfoWithPrevious: streamsInfo. 738 | 739 | ] 740 | 741 | { #category : #'tests - signals' } 742 | OSSUnixSubprocessTest >> testSigTermInsideLoop [ 743 | 744 | | process exited streamsInfo | 745 | 746 | exited := false. 747 | streamsInfo := self getStreamsInfoForRunningTest. 748 | process := self newCommand. 749 | 750 | process 751 | command: 'tail'; 752 | arguments: (Array with: '-f' with: Smalltalk image changesName); 753 | redirectStdout; 754 | redirectStderr; 755 | runAndWaitPollingEvery: (Delay forMilliseconds: 500) 756 | doing: [ :aProcess :outStream :errStream | 757 | "Imagine here that you have some condition...say.. elapsedTime > 1 h .. 758 | or ... stdOutStream size > 1MB or whatever.. " 759 | 760 | "#sigterm will throw an error (no such process) if the process with the given pid doesn't exist. Because of the looping of this method it COULD happen that we send #sigterm again even if the process was already killed in the previous loop. So we simply make sure the process is running before doing the #sigterm" 761 | aProcess isRunning ifTrue: [ aProcess sigterm. ] 762 | ] 763 | onExitDo: [ :aProcess :outStream :errStream | 764 | process closeAndCleanStreams. 765 | exited := true. 766 | self assert: aProcess exitStatusInterpreter printString equals: 'exit due to signal 15' 767 | ]. 768 | 769 | self assert: exited. 770 | self assertStreamsInfoWithPrevious: streamsInfo. 771 | 772 | ] 773 | 774 | { #category : #'tests - wait' } 775 | OSSUnixSubprocessTest >> testStopWaitingWithPolling [ 776 | | process counter oldZombies | 777 | process := self newCommand. 778 | oldZombies := self numberOfZombiesProcesses. 779 | counter := 0. 780 | [ 781 | process 782 | command: 'tail'; 783 | arguments: (Array with: '-f' with: Smalltalk image imagePath); 784 | redirectStdout; 785 | runAndWaitPollingEvery: (Delay forMilliseconds: 50) retrievingStreams: true onExitDo: [ :command :outString :errString | 786 | "The counter is to demonstrate that the exit happens only once we did the #stopWaiting 787 | and not before" 788 | self assert: counter equals: 0. 789 | self assert: process exitStatus isNil. 790 | "Since we did not wait for the child to finish we must do a sigterm to avoid zombies 791 | when running the tests" 792 | command sigterm. 793 | "Not sure about while this delay but it seems it's needed so that the next queryExitStatus 794 | does collect exit status and hence avoid zombies" 795 | (Delay forSeconds: 4) wait. 796 | command queryExitStatus. 797 | self assert: self numberOfZombiesProcesses equals: oldZombies. 798 | 799 | ] 800 | "The problem here is that we simply do a #fork this closure will continue to be executed while other test run. And so, all the test checking for zombies or opened files will fail because we can have this forked process that did not yet finish. A workaround is to simply run this closures with a higher priority so that there are less chances of other tests to be running. Another possibility would be to reject those 'tail' processes from #numberOfZombiesProcesses and #numberOfOpenFiles as all the tests that use #fork use the 'tail' OS command." 801 | ] forkAt: Processor userInterruptPriority. 802 | 803 | 804 | (Delay forSeconds: 3) wait. 805 | "Just to demonstrate that tail will run forever until explicitly closed". 806 | self assert: process isRunning. 807 | process stopWaiting. 808 | 809 | ] 810 | 811 | { #category : #'tests - wait' } 812 | OSSUnixSubprocessTest >> testStopWaitingWithSigchld [ 813 | | process counter oldZombies | 814 | process := self newCommand. 815 | oldZombies := self numberOfZombiesProcesses. 816 | counter := 0. 817 | [ 818 | process 819 | command: 'tail'; 820 | arguments: (Array with: '-f' with: Smalltalk image imagePath); 821 | redirectStdout; 822 | runAndWaitPollingEvery: (Delay forMilliseconds: 50) retrievingStreams: true onExitDo: [ :command :outString :errString | 823 | "The counter is to demonstrate that the exit happens only once we did the #stopWaiting 824 | and not before" 825 | self assert: counter equals: 0. 826 | self assert: command exitStatus isNil. 827 | "Since we did not wait for the child to finish we must do a sigterm to avoid zombies 828 | when running the tests" 829 | command sigterm. 830 | "Not sure about while this delay but it seems it's needed so that the next queryExitStatus 831 | does collect exit status and hence avoid zombies" 832 | (Delay forSeconds: 4) wait. 833 | command queryExitStatus. 834 | self assert: self numberOfZombiesProcesses equals: oldZombies. 835 | ] 836 | "The problem here is that we simply do a #fork this closure will continue to be executed while other test run. And so, all the test checking for zombies or opened files will fail because we can have this forked process that did not yet finish. A workaround is to simply run this closures with a higher priority so that there are less chances of other tests to be running. Another possibility would be to reject those 'tail' processes from #numberOfZombiesProcesses and #numberOfOpenFiles as all the tests that use #fork use the 'tail' OS command." 837 | ] forkAt: Processor userInterruptPriority. 838 | 839 | (Delay forSeconds: 3) wait. 840 | "Just to demonstrate that tail will run forever until explicitly closed". 841 | self assert: process isRunning. 842 | process stopWaiting. 843 | 844 | ] 845 | 846 | { #category : #'tests - wait' } 847 | OSSUnixSubprocessTest >> testWaitForExit [ 848 | | command | 849 | 850 | command := self newCommand 851 | command: '/bin/sleep'; 852 | arguments: {'3'}. 853 | 854 | command run. 855 | self assert: command pid > 0. 856 | self assert: [ command waitForExit ] timeToRun asSeconds >= 2. 857 | self assert: command exitStatusInterpreter exitStatus equals: 0. 858 | ] 859 | 860 | { #category : #'tests - wait' } 861 | OSSUnixSubprocessTest >> testWaitForExitPolling [ 862 | | command | 863 | 864 | command := self newCommand 865 | command: '/bin/sleep'; 866 | arguments: {'3'}. 867 | 868 | command run. 869 | self assert: command pid > 0. 870 | self assert: [ command waitForExitPolling ] timeToRun asSeconds >= 2. 871 | self assert: command exitStatusInterpreter exitStatus equals: 0. 872 | ] 873 | 874 | { #category : #'tests - wait' } 875 | OSSUnixSubprocessTest >> testWaitForExitPollingEvery [ 876 | | command | 877 | 878 | command := self newCommand 879 | command: '/bin/sleep'; 880 | arguments: {'3'}. 881 | 882 | command run. 883 | self assert: command pid > 0. 884 | self assert: [ command waitForExitPollingEvery: (Delay forSeconds: 1) ] timeToRun asSeconds >= 2. 885 | self assert: command exitStatusInterpreter exitStatus equals: 0. 886 | ] 887 | 888 | { #category : #'tests - high API' } 889 | OSSUnixSubprocessTest >> testWaitForExitPollingEveryDoing [ 890 | | streamsInfo totalRead | 891 | totalRead := String new writeStream. 892 | streamsInfo := self getStreamsInfoForRunningTest. 893 | self newCommand 894 | command: '/bin/ls'; 895 | arguments: (Array with: Smalltalk image imagePath); 896 | redirectStdout; 897 | redirectStderr; 898 | runAndWaitPollingEvery: (Delay forMilliseconds: 50) 899 | doing: [ :process :outStream :errStream | 900 | | read | 901 | read := outStream upToEnd. 902 | totalRead nextPutAll: read. 903 | ] 904 | onExitDo: [ :process :outStream :errStream | 905 | self assert: (totalRead contents includesSubstring: Smalltalk image imagePath). 906 | process closeAndCleanStreams. 907 | self assertStreamsInfoWithPrevious: streamsInfo. 908 | ]. 909 | 910 | 911 | ] 912 | 913 | { #category : #'tests - wait' } 914 | OSSUnixSubprocessTest >> testWaitForExitWithTimeoutWillFailIfProcessDoesNotFinish [ 915 | | command | 916 | 917 | command := self newCommand 918 | command: '/bin/sleep'; 919 | arguments: {'2'}. 920 | 921 | command run. 922 | 923 | self 924 | should: [ command waitForExitWithTimeout: 10 milliSeconds ] 925 | raise: OSSTimeout. 926 | self assert: command isRunning. 927 | ] 928 | 929 | { #category : #'tests - wait' } 930 | OSSUnixSubprocessTest >> testWaitForExitWithTimeoutWillNotTimeoutIfProcessFinishes [ 931 | | command | 932 | 933 | command := self newCommand 934 | command: '/bin/sleep'; 935 | arguments: {'1'}. 936 | 937 | command run. 938 | command waitForExitWithTimeout: 2 seconds. 939 | 940 | self assert: command pid > 0. 941 | self assert: command exitStatusInterpreter exitStatus equals: 0. 942 | ] 943 | 944 | { #category : #'tests - wait' } 945 | OSSUnixSubprocessTest >> testWaitpidIsNoneBocking [ 946 | | command childStatus | 947 | 948 | command := self newCommand 949 | command: '/bin/sleep'; 950 | arguments: {'5'}. 951 | 952 | command run. 953 | self assert: command pid > 0. 954 | (Duration seconds: 1) wait. 955 | self assert: [ childStatus := command exitStatusInterpreter ] timeToRun asSeconds < 1. 956 | self assert: childStatus value isNil. 957 | command waitForExit. 958 | ] 959 | 960 | { #category : #'tests - pwd' } 961 | OSSUnixSubprocessTest >> testWorkingDirectory [ 962 | | oldWorkingDirectory | 963 | 964 | oldWorkingDirectory := self systemAccessor getcwd. 965 | (FileSystem workingDirectory / 'testing') ensureCreateDirectory. 966 | 967 | self newCommand 968 | shellCommand: 'pwd'; 969 | workingDirectory: (FileSystem workingDirectory / 'testing') fullName; 970 | redirectStdout; 971 | runAndWaitOnExitDo: [ :command :outString | 972 | self assert: outString trimmed equals: (FileSystem workingDirectory / 'testing') fullName. 973 | ]. 974 | 975 | self assert: self systemAccessor getcwd trimmed equals: oldWorkingDirectory trimmed. 976 | 977 | (FileSystem workingDirectory / 'testing') ensureDelete. 978 | 979 | 980 | ] 981 | 982 | { #category : #helpers } 983 | OSSUnixSubprocessTest >> withNonAsciiDirectoryDo: aBlock [ 984 | | directory | 985 | directory := FileLocator temp / (self class name , '-éoï-' , UUIDGenerator next asString). 986 | directory ensureCreateDirectory. 987 | [ aBlock cull: directory asFileReference ] 988 | ensure: [ directory ensureDeleteAll ] 989 | ] 990 | -------------------------------------------------------------------------------- /repository/OSSubprocess-Tests-Unit/OSSVMProcessTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #OSSVMProcessTest, 3 | #superclass : #OSSAbstractUnixSubprocessTest, 4 | #category : 'OSSubprocess-Tests-Unit' 5 | } 6 | 7 | { #category : #accessing } 8 | OSSVMProcessTest >> runCaseManaged [ 9 | "testChangeDirWithNonAsciiCharacters test has to download the unicode table that can take some time. 10 | Disable test timeout." 11 | ^ self runCase 12 | ] 13 | 14 | { #category : #tests } 15 | OSSVMProcessTest >> testChangeDir [ 16 | | oldDir | 17 | oldDir := self systemAccessor getcwd. 18 | OSSVMProcess vmProcess 19 | lockCwdWithValue: '/tmp' 20 | encoding: #utf8 21 | during: [ 22 | "Grrr in latest OSX /tmp is mapped to /private/tmp..." 23 | self assert: ((self systemAccessor getcwd = '/tmp') or: [ self systemAccessor getcwd = '/private/tmp' ]). 24 | ]. 25 | self assert: self systemAccessor getcwd equals: oldDir 26 | 27 | ] 28 | 29 | { #category : #tests } 30 | OSSVMProcessTest >> testChangeDirWithNonAsciiCharacters [ 31 | | oldDir newDir duringSystemCwd | 32 | oldDir := self systemAccessor getcwd. 33 | newDir := FileLocator temp / 'strangË foldér namê'. 34 | newDir ensureCreateDirectory. 35 | 36 | OSSVMProcess vmProcess 37 | lockCwdWithValue: newDir fullName 38 | encoding: #utf8 39 | during: [ duringSystemCwd := self systemAccessor getcwd ]. 40 | duringSystemCwd := UnicodeNormalizer new toNFC: duringSystemCwd. 41 | 42 | "Grrr in latest OSX /tmp is mapped to /private/tmp..." 43 | self assert: ((duringSystemCwd = newDir fullName) or: [ duringSystemCwd = ('/private' , newDir fullName) ]). 44 | self assert: self systemAccessor getcwd equals: oldDir. 45 | newDir ensureDelete. 46 | ] 47 | 48 | { #category : #tests } 49 | OSSVMProcessTest >> testChangeDirWithNonExistingDir [ 50 | | oldDir | 51 | oldDir := self systemAccessor getcwd. 52 | [ OSSVMProcess vmProcess 53 | lockCwdWithValue: '/tmpWhatever' 54 | encoding: #utf8 55 | during: [ ] ] 56 | on: Error 57 | do: [ :ex | self assert: (ex printString includesSubstring: 'does not exist') ]. 58 | self assert: self systemAccessor getcwd equals: oldDir 59 | ] 60 | 61 | { #category : #tests } 62 | OSSVMProcessTest >> testChildrenCollectionsWithOneProcessBeforeAndAfter [ 63 | | command | 64 | OSSVMProcess vmProcess initializeAllMyChildren. 65 | command := self newCommand 66 | command: '/bin/sleep'; 67 | arguments: {'2'}. 68 | 69 | command run. 70 | 71 | self assert: OSSVMProcess vmProcess allMyChildren size equals: 1. 72 | self assert: OSSVMProcess vmProcess allMyChildren first == command. 73 | self assert: OSSVMProcess vmProcess activeChildren size equals: 1. 74 | self assert: OSSVMProcess vmProcess activeChildren first == command. 75 | self assert: OSSVMProcess vmProcess exitedChildren isEmpty. 76 | self assert: OSSVMProcess vmProcess childPids size equals: 1. 77 | self assert: OSSVMProcess vmProcess childPids first equals: command pid. 78 | 79 | command waitForExit. 80 | 81 | self assert: OSSVMProcess vmProcess allMyChildren size equals: 1. 82 | self assert: OSSVMProcess vmProcess allMyChildren first == command. 83 | self assert: OSSVMProcess vmProcess activeChildren size equals: 0. 84 | self assert: OSSVMProcess vmProcess exitedChildren size equals: 1. 85 | self assert: OSSVMProcess vmProcess exitedChildren first == command. 86 | self assert: OSSVMProcess vmProcess childPids size equals: 1. 87 | self assert: OSSVMProcess vmProcess childPids first equals: command pid. 88 | 89 | 90 | ] 91 | 92 | { #category : #tests } 93 | OSSVMProcessTest >> testInitializeChildren [ 94 | 95 | OSSVMProcess vmProcess initializeAllMyChildren. 96 | 97 | self assert: OSSVMProcess vmProcess allMyChildren isEmpty. 98 | self assert: OSSVMProcess vmProcess activeChildren isEmpty. 99 | self assert: OSSVMProcess vmProcess exitedChildren isEmpty. 100 | self assert: OSSVMProcess vmProcess childPids isEmpty. 101 | 102 | 103 | 104 | 105 | ] 106 | 107 | { #category : #tests } 108 | OSSVMProcessTest >> testPruneExitedChildrenAfter [ 109 | | command | 110 | OSSVMProcess vmProcess initializeAllMyChildren. 111 | command := self newCommand 112 | command: '/bin/ls'. 113 | command runAndWait. 114 | 115 | self assert: OSSVMProcess vmProcess exitedChildren size equals: 1. 116 | OSSVMProcess vmProcess pruneExitedChildrenAfter: 0. 117 | 118 | self assert: OSSVMProcess vmProcess allMyChildren isEmpty. 119 | self assert: OSSVMProcess vmProcess activeChildren isEmpty. 120 | self assert: OSSVMProcess vmProcess exitedChildren isEmpty. 121 | self assert: OSSVMProcess vmProcess childPids isEmpty. 122 | 123 | 124 | ] 125 | -------------------------------------------------------------------------------- /repository/OSSubprocess-Tests-Unit/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #'OSSubprocess-Tests-Unit' } 2 | -------------------------------------------------------------------------------- /repository/OSSubprocess/OSSAttachableFileStream.class.st: -------------------------------------------------------------------------------- 1 | " 2 | OSSAttachableFileStream represents a stream on an input or output channel provided by the underlying operating system. It behaves like an ordinary file stream, except that it can be attached myself to an input or output stream which has already been opened by the underlying operating system. 3 | 4 | The most common use is to represent either the read or write end of a Pipe from the Operatying System . This way, it provides a Stream API for both, reading and writing. An OSSPipe contains a 'reader' and a 'writer' which will be two different instances of this class. 5 | " 6 | Class { 7 | #name : 'OSSAttachableFileStream', 8 | #superclass : 'OldStandardFileStream', 9 | #instVars : [ 10 | 'autoClose' 11 | ], 12 | #category : 'OSSubprocess', 13 | #package : 'OSSubprocess' 14 | } 15 | 16 | { #category : 'file creation' } 17 | OSSAttachableFileStream class >> fileNamed: fileName [ 18 | "Since this is an attacheable stream it means the underlying stream in the OS 19 | has already been opened" 20 | 21 | self shouldNotImplement 22 | 23 | ] 24 | 25 | { #category : 'file creation' } 26 | OSSAttachableFileStream class >> isAFileNamed: fileName [ 27 | "Since this is an attacheable stream it means the underlying stream in the OS 28 | has already been opened" 29 | 30 | self shouldNotImplement 31 | 32 | ] 33 | 34 | { #category : 'instance creation' } 35 | OSSAttachableFileStream class >> name: aSymbolOrString attachTo: aFileID writable: readWriteFlag [ 36 | "Create a new instance attached to aFileID. For write streams, this represents two 37 | Smalltalk streams which write to the same OS file or output stream, 38 | presumably with interleaved output. The purpose of this method is to 39 | permit a FileStream to be attached to an existing aFileID, such as 40 | the handle for standard input, standard output, and standard error." 41 | 42 | ^ (super basicNew 43 | name: aSymbolOrString 44 | attachTo: aFileID 45 | writable: readWriteFlag) initialize 46 | ] 47 | 48 | { #category : 'TO USE LATER WITHOUT OSPROCESS' } 49 | OSSAttachableFileStream class >> name: aSymbolOrString attachToCFile: aCFile writable: readWriteFlag [ 50 | "Create a new instance attached to aCFile. For write streams, this represents two 51 | Smalltalk streams which write to the same OS file or output stream, 52 | presumably with interleaved output. The purpose of this method is to 53 | permit a FileStream to be attached to an existing aCFile, such as 54 | the handle for standard input, standard output, and standard error." 55 | 56 | ^ (super basicNew 57 | name: aSymbolOrString 58 | attachToCFile: aCFile 59 | writable: readWriteFlag) initialize 60 | ] 61 | 62 | { #category : 'file creation' } 63 | OSSAttachableFileStream class >> newFileNamed: fileName [ 64 | "Since this is an attacheable stream it means the underlying stream in the OS 65 | has already been opened" 66 | 67 | self shouldNotImplement 68 | 69 | ] 70 | 71 | { #category : 'file creation' } 72 | OSSAttachableFileStream class >> oldFileNamed: fileName [ 73 | "Since this is an attacheable stream it means the underlying stream in the OS 74 | has already been opened" 75 | 76 | self shouldNotImplement 77 | 78 | ] 79 | 80 | { #category : 'file creation' } 81 | OSSAttachableFileStream class >> readOnlyFileNamed: fileName [ 82 | "Since this is an attacheable stream it means the underlying stream in the OS 83 | has already been opened" 84 | 85 | self shouldNotImplement 86 | 87 | ] 88 | 89 | { #category : 'registry' } 90 | OSSAttachableFileStream class >> register: anObject [ 91 | "An attachable file stream is generally either a second reference to an 92 | existing file stream, or a reference to a transient object such as a pipe 93 | endpoint. There is no need to register it for finalization." 94 | 95 | ^ anObject 96 | ] 97 | 98 | { #category : 'registry' } 99 | OSSAttachableFileStream class >> unregister: anObject [ 100 | "An attachable file stream is generally either a second reference to an 101 | existing file stream, or a reference to a transient object such as a pipe 102 | endpoint. There is no need to register it for finalization." 103 | 104 | ^ anObject 105 | ] 106 | 107 | { #category : 'converting' } 108 | OSSAttachableFileStream >> asAttachableFileStream [ 109 | 110 | ^ self 111 | 112 | ] 113 | 114 | { #category : 'finalization' } 115 | OSSAttachableFileStream >> autoClose [ 116 | "Private. Answer true if the file should be automatically closed when 117 | this object is finalized." 118 | 119 | ^ autoClose 120 | ifNil: [autoClose := true] 121 | ] 122 | 123 | { #category : 'open/close' } 124 | OSSAttachableFileStream >> close [ 125 | "Close this file." 126 | 127 | | handle | 128 | (handle := self basicFileID) ifNotNil: [ 129 | self primCloseNoError: handle. 130 | self unregister. 131 | fileID := nil 132 | ] 133 | 134 | ] 135 | 136 | { #category : 'open/close' } 137 | OSSAttachableFileStream >> ensureOpen [ 138 | "Since this is an attacheable stream it means the underlying stream in the OS 139 | has already been opened" 140 | 141 | self shouldNotImplement 142 | 143 | ] 144 | 145 | { #category : 'finalization' } 146 | OSSAttachableFileStream >> finalize [ 147 | "If #autoClose is true, then we try to close the stream upon finalization - GC " 148 | 149 | self autoClose 150 | ifTrue: [[self primCloseNoError: fileID] on: Error do: []] 151 | ] 152 | 153 | { #category : 'read, write, position' } 154 | OSSAttachableFileStream >> flush [ 155 | "Flush the external OS stream (the one in the C library)." 156 | 157 | self systemAccessor fflush: self getFilePointerAsCFile 158 | ] 159 | 160 | { #category : 'finalization' } 161 | OSSAttachableFileStream >> keepOpen [ 162 | "Do not allow the file to be closed when this object is finalized." 163 | 164 | autoClose := false 165 | 166 | ] 167 | 168 | { #category : 'attaching' } 169 | OSSAttachableFileStream >> name: aSymbolOrString attachTo: aFileID writable: readWriteFlag [ 170 | "Attach to an existing file handle, assumed to have been previously 171 | opened by the underlying operating system. 172 | " 173 | 174 | name := aSymbolOrString. 175 | fileID := aFileID. 176 | readWriteFlag ifTrue: [self readWrite] ifFalse: [self readOnly]. 177 | self ascii. 178 | self register 179 | 180 | 181 | ] 182 | 183 | { #category : 'TO USE LATER WITHOUT OSPROCESS' } 184 | OSSAttachableFileStream >> name: aSymbolOrString attachToCFile: externalFilePointer writable: readWriteFlag [ 185 | "Attach to an existing file handle, assumed to have been previously opened by the underlying operating system. 186 | We assume a 32 bits machine and here we document the SQFile used by the VM: 187 | /* squeak file record; see sqFilePrims.c for details */ 188 | typedef struct { 189 | int sessionID; /* ikp: must be first */ 190 | void *file; 191 | squeakFileOffsetType fileSize; /* 64-bits we hope. */ 192 | char writable; 193 | char lastOp; /* 0 = uncommitted, 1 = read, 2 = write */ 194 | char lastChar; 195 | char isStdioStream; 196 | } SQFile; 197 | " 198 | | fileIDByteArray | 199 | self flag: #fixIt. 200 | "Hack...I calculated that the size of the SQFile struct in a 32 bits machine is 20 bytes only 201 | if the fileSize was 64 bits. This is the case of Pharo OSX VM. However, Linux VM has not yet been build 202 | with 64 buts but 32 bits for fileSize and so, instead of 20 it is 16. 203 | For more details read thread with subject 'Why StandardFileStream fileID is 16 bytes in Linux while 20 bytes in OSX?' 204 | " 205 | fileIDByteArray := ByteArray new: 20. 206 | name := aSymbolOrString. 207 | self setSessionIDTo: fileIDByteArray. 208 | "Hack. I calculated that the File* of the SQFile is the second element of the struct and starts at the byte 5. 209 | The first 4 byets is the session ID. " 210 | self setOSFilePointerFromByteArray: externalFilePointer getHandle getHandle asByteArrayPointer to: fileIDByteArray offset: 4. 211 | readWriteFlag 212 | ifTrue: [ 213 | self flag: #fixIt. 214 | "Again, in 32 bytes machines, the byte17 is the variable 'writable' from the SQFile. 215 | In Linux, instead if 17 it should be 13. 216 | " 217 | fileIDByteArray at: 17 put: 1. 218 | self readWrite] 219 | ifFalse: [ 220 | self readOnly]. 221 | fileID := fileIDByteArray. 222 | self ascii. 223 | self register 224 | 225 | ] 226 | 227 | { #category : 'TO USE LATER WITHOUT OSPROCESS' } 228 | OSSAttachableFileStream >> oldname: aSymbolOrString attachTo: externalFilePointer writable: readWriteFlag [ 229 | "Attach to an existing file handle, assumed to have been previously opened by the underlying operating system. 230 | We assume a 32 bits machine and here we document the SQFile used by the VM: 231 | /* squeak file record; see sqFilePrims.c for details */ 232 | typedef struct { 233 | int sessionID; /* ikp: must be first */ 234 | void *file; 235 | squeakFileOffsetType fileSize; /* 64-bits we hope. */ 236 | char writable; 237 | char lastOp; /* 0 = uncommitted, 1 = read, 2 = write */ 238 | char lastChar; 239 | char isStdioStream; 240 | } SQFile; 241 | " 242 | | fileIDByteArray | 243 | "Hack...I calculated that the size of the SQFile struct in a 32 bits machine is 20 bytes. " 244 | fileIDByteArray := ByteArray new: 20. 245 | name := aSymbolOrString. 246 | self setSessionIDTo: fileIDByteArray. 247 | "Hack. I calculated that the File* of the SQFile is the second element of the struct and starts at the byte 5. 248 | The first 4 byets is the session ID. " 249 | self setOSFilePointerFromByteArray: externalFilePointer getHandle getHandle asByteArrayPointer to: fileIDByteArray offset: 4. 250 | readWriteFlag 251 | ifTrue: [ 252 | "Again, in 32 bytes machines, the byte17 is the variable 'writable' from the SQFile. " 253 | fileIDByteArray at: 17 put: 1. 254 | self readWrite] 255 | ifFalse: [ 256 | self readOnly]. 257 | fileID := fileIDByteArray. 258 | self ascii. 259 | self register 260 | 261 | ] 262 | 263 | { #category : 'open/close' } 264 | OSSAttachableFileStream >> open [ 265 | "Since this is an attacheable stream it means the underlying stream in the OS 266 | has already been opened" 267 | 268 | self shouldNotImplement 269 | 270 | ] 271 | 272 | { #category : 'open/close' } 273 | OSSAttachableFileStream >> open: fileName forWrite: writeMode [ 274 | "Since this is an attacheable stream it means the underlying stream in the OS 275 | has already been opened" 276 | 277 | self shouldNotImplement 278 | 279 | ] 280 | 281 | { #category : 'open/close' } 282 | OSSAttachableFileStream >> openReadOnly [ 283 | "Since this is an attacheable stream it means the underlying stream in the OS 284 | has already been opened" 285 | 286 | self shouldNotImplement 287 | 288 | ] 289 | 290 | { #category : 'read, write, position' } 291 | OSSAttachableFileStream >> position [ 292 | "Return the receiver's current file position. If the stream is not positionable, 293 | as in the case of a Unix pipe stream, answer 0." 294 | 295 | ^ [super position] 296 | on: Error 297 | do: [0] 298 | 299 | ] 300 | 301 | { #category : 'open/close' } 302 | OSSAttachableFileStream >> reopen [ 303 | "Since this is an attacheable stream it means the underlying stream in the OS 304 | has already been opened" 305 | 306 | self shouldNotImplement 307 | 308 | ] 309 | 310 | { #category : 'non blocking' } 311 | OSSAttachableFileStream >> setNonBlocking [ 312 | "Make this stream to be none blocking. In Linux it means 313 | calling fcntl() to set the file non-blocking (O_NONBLOCK)." 314 | 315 | self systemAccessor makeFileNoneBocking: fileID 316 | ] 317 | 318 | { #category : 'TO USE LATER WITHOUT OSPROCESS' } 319 | OSSAttachableFileStream >> setOSFilePointerFromByteArray: externalFilePointer to: aDestByteArray offset: anOffsetNumber [ 320 | 1 to: 4 do: [ :index | aDestByteArray at: (index + anOffsetNumber) put: (externalFilePointer at: index) ] 321 | 322 | ] 323 | 324 | { #category : 'TO USE LATER WITHOUT OSPROCESS' } 325 | OSSAttachableFileStream >> setSessionIDTo: fileIDByteArray [ 326 | | currentSession | 327 | currentSession := OSSVMProcess vmProcess sessionID. 328 | 1 to: currentSession size do: [ :index | fileIDByteArray at: index put: (currentSession at: index) ] 329 | ] 330 | 331 | { #category : 'read, write, position' } 332 | OSSAttachableFileStream >> upToEnd [ 333 | "Answer a subcollection from the current access position through the last element 334 | of the receiver. This is slower than the method in StandardFileStream, but it 335 | works with pipes which answer false to #atEnd when no further input is 336 | currently available, but the pipe is not yet closed." 337 | 338 | | newStream buffer nextBytes | 339 | buffer := buffer1 species new: 1000. 340 | newStream := WriteStream on: (buffer1 species new: 100). 341 | [self atEnd or: [(nextBytes := self nextInto: buffer) isEmpty]] 342 | whileFalse: [newStream nextPutAll: nextBytes]. 343 | ^ newStream contents 344 | 345 | ] 346 | -------------------------------------------------------------------------------- /repository/OSSubprocess/OSSCFile.class.st: -------------------------------------------------------------------------------- 1 | " 2 | OSSCFile is a external object which provides a way for mapping C-level FILE* in our FFI calls. We have FFI calls that either answer or receive FILE* and in these cases we use OSSCFile for the FFI signature. 3 | " 4 | Class { 5 | #name : 'OSSCFile', 6 | #superclass : 'FFIExternalObject', 7 | #category : 'OSSubprocess', 8 | #package : 'OSSubprocess' 9 | } 10 | -------------------------------------------------------------------------------- /repository/OSSubprocess/OSSPipe.class.st: -------------------------------------------------------------------------------- 1 | " 2 | OSSPipe represents a pipe provided by the underlying operating system, such as a Unix pipe. I have a reader stream and a writer stream which behave similarly to a read-only FileStream and a writeable FileStream. These streams are instances of OSSAttachableFileStream which are attached to the underlying created pipe (to either read and write end). 3 | 4 | The idea of OSSPipe is to provide an Stream-like API for pipes. The write-related methods will be delagated to the 'writer' (for example, #nextPutAll:) and the read-related methods (like #upToEnd) will be forwarded to the reader. 5 | 6 | Thanks to the Stream-API, it almos allows a code user, to either use Pipes or regular files polymorphically. In fact, OSSUnixSubprocess can either work with regular files or with OSSPipe for dealing with stdin, stdout and stderr. 7 | 8 | OSSPipe uses a single-character buffer to implement #peek without losing data from the external OS pipe. 9 | " 10 | Class { 11 | #name : 'OSSPipe', 12 | #superclass : 'Stream', 13 | #instVars : [ 14 | 'readBlocking', 15 | 'writer', 16 | 'reader', 17 | 'nextChar' 18 | ], 19 | #category : 'OSSubprocess', 20 | #package : 'OSSubprocess' 21 | } 22 | 23 | { #category : 'instance creation' } 24 | OSSPipe class >> newWith: fileIDsArray readBlocking: readBlocking [ 25 | "fileIDsArray is an array of two elements where the first represents a sqFile struct of the reader of the pipe and the second represents the sqFile of the writer of the pipe. 26 | If readBlocking is true, then the pipe will lock the reading waiting until there is data. If false, then the streams will not lock and answer immediatly instead. 27 | " 28 | ^ self basicNew 29 | initializeWith: fileIDsArray readBlocking: readBlocking 30 | yourself 31 | 32 | 33 | ] 34 | 35 | { #category : 'testing' } 36 | OSSPipe >> atEnd [ 37 | "Answer whether the receiver can access any more objects." 38 | 39 | ^ writer closed and: [self peek == nil] 40 | 41 | ] 42 | 43 | { #category : 'testing' } 44 | OSSPipe >> atEndOfFile [ 45 | "Answer whether the receiver is at its end based on the result of 46 | the last read operation. This uses feof() to test the underlying file 47 | stream status, and can be used as an alternative to #atEnd, which 48 | does not properly report end of file status for an OSSPipe." 49 | 50 | ^ reader atEndOfFile 51 | 52 | ] 53 | 54 | { #category : 'closing' } 55 | OSSPipe >> close [ 56 | "Closes both streams" 57 | 58 | self closeWriter. 59 | self closeReader. 60 | 61 | ] 62 | 63 | { #category : 'closing' } 64 | OSSPipe >> closeReader [ 65 | 66 | reader ifNotNil: [reader close] 67 | 68 | ] 69 | 70 | { #category : 'closing' } 71 | OSSPipe >> closeWriter [ 72 | 73 | writer ifNotNil: [writer close] 74 | 75 | ] 76 | 77 | { #category : 'testing' } 78 | OSSPipe >> closed [ 79 | 80 | ^ reader closed 81 | ] 82 | 83 | { #category : 'accessing' } 84 | OSSPipe >> contents [ 85 | "Answer contents of the pipe, and return the contents to the pipe so it can still be read." 86 | 87 | | string | 88 | self closed ifTrue: 89 | [self notify: self printString, ' ', self reader printString, ' closed'. 90 | ^ nil]. 91 | string := self reader upToEnd. 92 | string isEmpty ifFalse: 93 | [self writer closed 94 | ifTrue: [self notify: self printString, ' ', self writer printString, 95 | ' closed, cannot replace contents'] 96 | ifFalse: [self nextPutAll: string]]. 97 | ^ string 98 | ] 99 | 100 | { #category : 'character writing' } 101 | OSSPipe >> cr [ 102 | "Append a return character to the receiver." 103 | 104 | self writer cr 105 | ] 106 | 107 | { #category : 'read, write, position' } 108 | OSSPipe >> flush [ 109 | ^writer flush 110 | ] 111 | 112 | { #category : 'initialize - release' } 113 | OSSPipe >> initializeWith: fileIDsArray readBlocking: aBoolean [ 114 | super initialize. 115 | readBlocking := aBoolean. 116 | self openReadStreamFor: fileIDsArray first withName: 'pipeReader'. 117 | self openWriteStreamFor: fileIDsArray second withName: 'pipeWriter'. 118 | ] 119 | 120 | { #category : 'read, write, position' } 121 | OSSPipe >> next [ 122 | "Answer the next object accessible by the receiver." 123 | 124 | | character | 125 | nextChar isNil 126 | ifTrue: 127 | [^ [reader next] 128 | on: Error 129 | do: [nil]] 130 | ifFalse: 131 | [character := nextChar. 132 | nextChar := nil. 133 | ^ character] 134 | 135 | ] 136 | 137 | { #category : 'read, write, position' } 138 | OSSPipe >> next: anInteger [ 139 | "Answer the next anInteger elements of my collection." 140 | 141 | | character stream | 142 | stream := WriteStream on: String new. 143 | (1 to: anInteger) do: 144 | [:index | 145 | character := self next. 146 | character isNil 147 | ifTrue: [^ stream contents] 148 | ifFalse: [stream nextPut: character. false]]. 149 | ^ stream contents 150 | 151 | ] 152 | 153 | { #category : 'read, write, position' } 154 | OSSPipe >> nextPut: anObject [ 155 | "Insert the argument, anObject, as the next object accessible by the 156 | receiver. Answer anObject." 157 | 158 | ^ writer nextPut: anObject 159 | ] 160 | 161 | { #category : 'read, write, position' } 162 | OSSPipe >> nextPutAll: aCollection [ 163 | "Append the elements of aCollection to the sequence of objects accessible 164 | by the receiver. Answer aCollection." 165 | 166 | ^ writer nextPutAll: aCollection 167 | ] 168 | 169 | { #category : 'initialize - release' } 170 | OSSPipe >> openReadStreamFor: aFileID withName: aReadStreamName [ 171 | "Creates a read OSSAttachableFileStream for the read end of the pipe. 172 | If the readBlock is false, then make the stream to be non blocking. " 173 | reader := OSSAttachableFileStream name: aReadStreamName attachTo: aFileID writable: false. 174 | readBlocking ifFalse: [ reader setNonBlocking ]. 175 | ^ reader 176 | ] 177 | 178 | { #category : 'initialize - release' } 179 | OSSPipe >> openWriteStreamFor: aFileID withName: aWriteStreamName [ 180 | "Creates a write OSSAttachableFileStream for the write end of the pipe. " 181 | writer := OSSAttachableFileStream name: aWriteStreamName attachTo: aFileID writable: true. 182 | ^ writer 183 | ] 184 | 185 | { #category : 'testing' } 186 | OSSPipe >> ossIsPipe [ 187 | 188 | ^ true 189 | 190 | ] 191 | 192 | { #category : 'read, write, position' } 193 | OSSPipe >> peek [ 194 | 195 | ^ nextChar isNil 196 | ifTrue: [reader closed 197 | ifFalse: [nextChar := reader next]] 198 | ifFalse: [nextChar] 199 | ] 200 | 201 | { #category : 'printing' } 202 | OSSPipe >> printOn: aStream [ 203 | "The implementation of Stream>>printOn: has bad side effects when used 204 | for OSPipe. This implementation is copied from Object." 205 | 206 | | title | 207 | title := self class name. 208 | aStream 209 | nextPutAll: (title first isVowel ifTrue: ['an '] ifFalse: ['a ']); 210 | nextPutAll: title 211 | ] 212 | 213 | { #category : 'accessing' } 214 | OSSPipe >> reader [ 215 | "Answer a stream on the read end of the pipe." 216 | 217 | ^ reader 218 | ] 219 | 220 | { #category : 'accessing' } 221 | OSSPipe >> reader: aReadStream [ 222 | 223 | reader := aReadStream 224 | ] 225 | 226 | { #category : 'accessing' } 227 | OSSPipe >> systemAccessor [ 228 | ^ OSSVMProcess vmProcess systemAccessor 229 | ] 230 | 231 | { #category : 'read, write, position' } 232 | OSSPipe >> upToEnd [ 233 | "Answer the remaining elements in the string." 234 | 235 | | strm s | 236 | strm := WriteStream on: String new. 237 | [(s := self next: 2000) isEmpty 238 | ifTrue: [^ strm contents] 239 | ifFalse: [strm nextPutAll: s]] repeat 240 | 241 | ] 242 | 243 | { #category : 'read, write, position' } 244 | OSSPipe >> upToEndOfFile [ 245 | "Answer the remaining elements in the pipe. Use #atEndOfFile to 246 | determine end of file status with feof(), required for reliable end of 247 | file test on OS pipes. Compare #upToEnd, which uses the generic end 248 | of file test in FilePlugin." 249 | 250 | | stream delay string | 251 | stream := WriteStream on: String new. 252 | delay := Delay forMilliseconds: 200. 253 | [(string := self next: 2000) isEmpty 254 | ifTrue: [self atEndOfFile 255 | ifTrue: [^ stream contents] 256 | ifFalse: [delay wait]] 257 | ifFalse: [stream nextPutAll: string]] repeat 258 | 259 | ] 260 | 261 | { #category : 'accessing' } 262 | OSSPipe >> writer [ 263 | "Answer a stream on the write end of the pipe." 264 | 265 | ^ writer 266 | ] 267 | 268 | { #category : 'accessing' } 269 | OSSPipe >> writer: aWriteStream [ 270 | 271 | writer := aWriteStream 272 | ] 273 | -------------------------------------------------------------------------------- /repository/OSSubprocess/OSSTimeout.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'OSSTimeout', 3 | #superclass : 'Error', 4 | #category : 'OSSubprocess', 5 | #package : 'OSSubprocess' 6 | } 7 | -------------------------------------------------------------------------------- /repository/OSSubprocess/OSSUnixProcessExitStatus.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A OSSUnixProcessExitStatus represents the exit status of a unix process. This is an integer bit field answered by the wait() system call that contains information about exit status of the process. The meaning of the bit field varies according to the cause of process exit. 3 | 4 | When the OS process of a OSSUnixSubprocess exits and we collect the exit status via (#queryExitStatus which ends up doing the waitpid()), we get this bit integer bit fields. 5 | OSSUnixSubprocess #exitStatus answers this integer. To interpret it's result better, then we use this class OSSUnixProcessExitStatus (via #exitStatusInterpreter). 6 | 7 | Ideally, we should take the resulting integer and call the macros WIFSIGNALED, WIFEXITED etc.. but since they are macros, they are not accessible via FFI. Therefore, we do the internal bit shits ourselves. 8 | 9 | However, OSSUnixProcessExitStatus decodes the process exit status in a manner compatible with a typical GNU unix implementation. It is not guaranteed to be portable and may produce misleading results on other unix systems. 10 | 11 | Following a normal process exit, the status may be decoded to provide a small positive integer value in the range 0 - 255, which is the value that is presented by a unix shell as the exit status of a program. If terminated by a signal, the corresponding value is the signal number of the signal that caused process exit. 12 | 13 | 14 | " 15 | Class { 16 | #name : 'OSSUnixProcessExitStatus', 17 | #superclass : 'Object', 18 | #instVars : [ 19 | 'intValue' 20 | ], 21 | #category : 'OSSubprocess', 22 | #package : 'OSSubprocess' 23 | } 24 | 25 | { #category : 'instance creation' } 26 | OSSUnixProcessExitStatus class >> for: integerValue [ 27 | 28 | ^self new for: integerValue 29 | 30 | ] 31 | 32 | { #category : 'accessing' } 33 | OSSUnixProcessExitStatus >> exitStatus [ 34 | 35 | self isExited ifTrue: [^self statusIfExited]. 36 | self isSignaled ifTrue: [^self statusIfSignaled]. 37 | self isStopped ifTrue: [^self statusIfStopped]. 38 | self notify: 'cannot decode exit status ', intValue asString. 39 | ^intValue 40 | ] 41 | 42 | { #category : 'initialize-release' } 43 | OSSUnixProcessExitStatus >> for: anInteger [ 44 | intValue := anInteger 45 | ] 46 | 47 | { #category : 'testing' } 48 | OSSUnixProcessExitStatus >> isExited [ 49 | " 50 | /* Nonzero if STATUS indicates normal termination. */ 51 | #define __WIFEXITED(status) (__WTERMSIG(status) == 0) 52 | " 53 | ^ self statusIfSignaled = 0 54 | 55 | 56 | ] 57 | 58 | { #category : 'testing' } 59 | OSSUnixProcessExitStatus >> isSignaled [ 60 | " 61 | /* Nonzero if STATUS indicates termination by a signal. */ 62 | #define __WIFSIGNALED(status) \ 63 | (((signed char) (((status) & 0x7f) + 1) >> 1) > 0) 64 | " 65 | ^(((intValue bitAnd: 16r7F) + 1) >> 1) > 0 66 | 67 | 68 | ] 69 | 70 | { #category : 'testing' } 71 | OSSUnixProcessExitStatus >> isStopped [ 72 | " 73 | /* Nonzero if STATUS indicates the child is stopped. */ 74 | #define __WIFSTOPPED(status) (((status) & 0xff) == 0x7f) 75 | " 76 | ^(intValue bitAnd: 16rFF) = 16r7F 77 | 78 | 79 | ] 80 | 81 | { #category : 'testing' } 82 | OSSUnixProcessExitStatus >> isSuccess [ 83 | ^ self exitStatus = 0 84 | ] 85 | 86 | { #category : 'testing' } 87 | OSSUnixProcessExitStatus >> notFinished [ 88 | 89 | ^ intValue isNil 90 | 91 | ] 92 | 93 | { #category : 'printing' } 94 | OSSUnixProcessExitStatus >> printOn: aStream [ 95 | 96 | self notFinished 97 | ifTrue: [^ aStream nextPutAll: 'Not finished']. 98 | self isExited 99 | ifTrue: [aStream nextPutAll: 'normal termination with status '; 100 | nextPutAll: self statusIfExited asString]. 101 | self isSignaled 102 | ifTrue: [aStream nextPutAll: 'exit due to signal '; 103 | nextPutAll: self statusIfSignaled asString]. 104 | self isStopped 105 | ifTrue: [aStream nextPutAll: 'stopped due to signal '; 106 | nextPutAll: self statusIfStopped]. 107 | ] 108 | 109 | { #category : 'accessing' } 110 | OSSUnixProcessExitStatus >> statusIfExited [ 111 | " 112 | /* If WIFEXITED(STATUS), the low-order 8 bits of the status. */ 113 | #define __WEXITSTATUS(status) (((status) & 0xff00) >> 8) 114 | " 115 | ^(intValue bitAnd: 16rFF00) >> 8 116 | ] 117 | 118 | { #category : 'accessing' } 119 | OSSUnixProcessExitStatus >> statusIfSignaled [ 120 | " 121 | /* If WIFSIGNALED(STATUS), the terminating signal. */ 122 | #define __WTERMSIG(status) ((status) & 0x7f) 123 | " 124 | ^intValue bitAnd: 16r7F 125 | ] 126 | 127 | { #category : 'accessing' } 128 | OSSUnixProcessExitStatus >> statusIfStopped [ 129 | " 130 | /* If WIFSTOPPED(STATUS), the signal that stopped the child. */ 131 | #define __WSTOPSIG(status) __WEXITSTATUS(status) 132 | " 133 | ^self statusIfExited 134 | ] 135 | 136 | { #category : 'accessing' } 137 | OSSUnixProcessExitStatus >> statusNotFinished [ 138 | 139 | ^ 'Not finished' 140 | ] 141 | 142 | { #category : 'accessing' } 143 | OSSUnixProcessExitStatus >> value [ 144 | ^intValue 145 | ] 146 | -------------------------------------------------------------------------------- /repository/OSSubprocess/OSSUnixSystemAccessor.class.st: -------------------------------------------------------------------------------- 1 | " 2 | OSSUnixSystemAccessor provides access to the operating system in which the Pharo VM is currently running. There is only one instance of this class, holded by 'OSSVMProcess vmProcess' which depends on it to provide access to the operating system process which they represent. 3 | 4 | This class provides GENERAL funcionallity for managing files, errors, environments variables, waiting calls, etc etc. Ideally, 100% of its functionallity should be implemented via FFI calls. However, we still use some OSProcess primitives which would be a bit complicaated to implement via FFI (mostly because they access macros, or constants, or things related to a the C pre-processor that we do not have at FFI level). 5 | 6 | The functionallity that is NOT GENERAL (like the call to posix_spawn() family of functions), should not be here but in the concrete place such as OSSUnixSubprocess. 7 | 8 | For the parts that are based on FFI calls, we split each call in two sides. The first side is the method that does the FFI call (under a 'XXX - primitives' protocol, for example, #primitiveFileno:). The other side, is wrapper method that calls the primitive internally but also takes care about managing possible errors of it, informing those, etc (for example, #fileno:). Therefore, is very much likely that the ""code users"" of this class, will be using the latter side (wrappers) of the methods and not the primitive ones. 9 | 10 | !! Management of dead processes 11 | 12 | New processes are created as childs of the current process. The method #waitpidNoHang: is used to query the exit status of processes. 13 | However, since we use the waitpid() function using WNOHANG, it returns a finished process id that is not necessarily the one that is asked for. 14 | Becayse of this, the Accessor contains a map of process exit statuses. 15 | If the asked process is the one returned by waitpid, we return the corresponding exit status, otherwise we store that value in the map for later accesses. 16 | " 17 | Class { 18 | #name : 'OSSUnixSystemAccessor', 19 | #superclass : 'Object', 20 | #instVars : [ 21 | 'finishedChildProcesses' 22 | ], 23 | #classVars : [ 24 | 'VMProcessSystemAcessor' 25 | ], 26 | #pools : [ 27 | 'LibCWaitSharedPool' 28 | ], 29 | #category : 'OSSubprocess', 30 | #package : 'OSSubprocess' 31 | } 32 | 33 | { #category : 'instance creation' } 34 | OSSUnixSystemAccessor class >> forVMProcess [ 35 | ^ VMProcessSystemAcessor ifNil: [ VMProcessSystemAcessor := self basicNew initialize ] 36 | 37 | ] 38 | 39 | { #category : 'instance creation' } 40 | OSSUnixSystemAccessor class >> new [ 41 | 42 | self error: 'You cannot create instances of OSSUnixSystemAccessor. You can only access the correct instance via OSSVMProcess >> systemAccessor '. 43 | 44 | ] 45 | 46 | { #category : 'cwd' } 47 | OSSUnixSystemAccessor >> chdir: aDirString encoding: encoding [ 48 | "Changes the current working directory of the vmProcess to aDirString" 49 | | returnValue | 50 | returnValue := self primitiveChdir: aDirString encoding: encoding. 51 | (returnValue = -1) ifTrue: [ self perror: 'chdir()' ]. 52 | (returnValue = 0) ifFalse: [ self error: 'Unexpected return value from chdir() ', returnValue printString ]. 53 | 54 | ] 55 | 56 | { #category : 'files' } 57 | OSSUnixSystemAccessor >> closeFileDescriptor: aFileDescription [ 58 | "It closes the stream associated to aFileDescriptor" 59 | | returnValue | 60 | returnValue := self primitiveClose: aFileDescription. 61 | (returnValue = -1) ifTrue: [ self perror: 'close()' ]. 62 | ^ returnValue 63 | 64 | ] 65 | 66 | { #category : 'files' } 67 | OSSUnixSystemAccessor >> feof: aCFile [ 68 | "Answers whether a FILE* is at the end of the file or not. This is trustful for pipes too" 69 | | result | 70 | result := self primitiveFeof: aCFile. 71 | ^ result ~= 0 72 | 73 | 74 | ] 75 | 76 | { #category : 'private - support primitives' } 77 | OSSUnixSystemAccessor >> ffiLibraryName [ 78 | ^ LibC 79 | ] 80 | 81 | { #category : 'files' } 82 | OSSUnixSystemAccessor >> fflush: aCFile [ 83 | "Flushes the file associated to the FILE* represented by aCFile" 84 | | returnValue | 85 | aCFile ifNil: [ self error: 'We disallow the fflush() of nil files since it will flush all open output streams' ]. 86 | returnValue := self primitiveFflush: aCFile. 87 | (returnValue = 0) ifFalse: [ self perror: 'fflush()' ]. 88 | 89 | ] 90 | 91 | { #category : 'NOT CURRENTLY USED' } 92 | OSSUnixSystemAccessor >> fileDescriptorOpen: aFileDescription mode: aMode [ 93 | | cFile | 94 | cFile := self primitiveFdopen: aFileDescription mode: aMode. 95 | cFile isNull ifTrue: [ self perror: 'fdopen()' ]. 96 | ^ cFile 97 | 98 | ] 99 | 100 | { #category : 'files' } 101 | OSSUnixSystemAccessor >> fileno: aCFile [ 102 | "Answers the file descriptor associated to the FILE* represented by aCFile" 103 | | returnValue | 104 | returnValue := self primitiveFileno: aCFile. 105 | (returnValue = -1) ifTrue: [ self perror: 'fileno()' ]. 106 | ^ returnValue "file descriptor" 107 | ] 108 | 109 | { #category : 'USING FROM OSPROCESS' } 110 | OSSUnixSystemAccessor >> forwardSigChld [ 111 | "Set a signal handler for SIGCHLD. Answer a new Semaphore, or nil if unable 112 | to set the handler (possibly because it has already been set)." 113 | 114 | ^ self forwardSignal: self primSigChldNumber 115 | 116 | ] 117 | 118 | { #category : 'USING FROM OSPROCESS' } 119 | OSSUnixSystemAccessor >> forwardSignal: signalNumber [ 120 | "Set a signal handler in the VM which will signal a Smalltalk semaphore 121 | at semaphoreIndex whenever an external signal signalNumber is received. 122 | Answer a new Semaphore, or nil if unable to set the handler (possibly 123 | because it has already been set). A Smalltalk process can wait on the 124 | Semaphore, and take action when a signal is detected. See man(7) signal 125 | for signal number definitions on your unix system." 126 | 127 | | sema index | 128 | sema := Semaphore new. 129 | index := Smalltalk registerExternalObject: sema. 130 | (self primForwardSignal: signalNumber toSemaphore: index) 131 | ifNil: 132 | [Smalltalk unregisterExternalObject: sema. 133 | ^ nil]. 134 | ^ sema 135 | ] 136 | 137 | { #category : 'general' } 138 | OSSUnixSystemAccessor >> getPid [ 139 | "Answers the PID of the vmProcess" 140 | ^ self primitiveGetpid 141 | ] 142 | 143 | { #category : 'cwd' } 144 | OSSUnixSystemAccessor >> getcwd [ 145 | "Returns the current working directory of the vmProcess" 146 | | buffer bytesRead | 147 | "Ideally, we should use a smaller buffer and then if the answer is NULL 148 | and errno is ERANGE then try again with a larget buffer. But...since we cannot 149 | have access to errno.... we simply create a very large buffer that we trust that 150 | any path fill fit in it..." 151 | buffer := ExternalAddress allocate: 4096 + 1. 152 | [ 153 | bytesRead := self primitiveGetcwd: buffer size: 4096 + 1. 154 | bytesRead ifNil: [ self perror: 'getcwd()']. 155 | ] ensure: [ buffer free ]. 156 | ^ bytesRead 157 | 158 | ] 159 | 160 | { #category : 'initialization' } 161 | OSSUnixSystemAccessor >> initialize [ 162 | 163 | super initialize. 164 | finishedChildProcesses := Dictionary new 165 | ] 166 | 167 | { #category : 'signals' } 168 | OSSUnixSystemAccessor >> kill: aPid signal: aSignal [ 169 | "Sends aSignal to aPid" 170 | | answer | 171 | answer := self primitiveKill: aPid signal: aSignal. 172 | (answer = -1) ifTrue: [ 173 | self perror: 'kill()'. 174 | ]. 175 | (answer = 0) 176 | ifTrue: [ ^ answer ] 177 | ifFalse: [ self error: 'Unkown answer for kill()' ] 178 | ] 179 | 180 | { #category : 'pipes' } 181 | OSSUnixSystemAccessor >> makeBlockingPipe [ 182 | " Create a pipes with blocking reads" 183 | ^ self makePipeWithReadBlocking: true 184 | ] 185 | 186 | { #category : 'files' } 187 | OSSUnixSystemAccessor >> makeFileNoneBocking: aFileId [ 188 | "Make this stream to be none blocking. In Linux it means 189 | calling fcntl() to set the file non-blocking (O_NONBLOCK)." 190 | self primSQFileSetNonBlocking: aFileId 191 | 192 | ] 193 | 194 | { #category : 'pipes' } 195 | OSSUnixSystemAccessor >> makeNonBlockingPipe [ 196 | "Creates a pipe with non blocking read" 197 | ^ self makePipeWithReadBlocking: false 198 | ] 199 | 200 | { #category : 'pipes' } 201 | OSSUnixSystemAccessor >> makePipeWithReadBlocking: aBoolean [ 202 | "Originally, we created the pipes ourselves and the answer was an array of file descriptors. 203 | This was complicated because we have to then create our own sqFile structure and deal 204 | with with offsets and their sizeof(). 205 | 206 | So now we use OSProcess primitive primCreatePipe which directly answers an array of sqFile structs 207 | specifially created for them. This way we avoid all the sqFile creation and management at image side. 208 | " 209 | 210 | " ==================== OLD CODe ======================= 211 | | pipePointer returnValue fileDescriptors | 212 | pipePointer := ExternalAddress allocate: 8. 213 | [ 214 | returnValue := self primitivePipe: pipePointer. 215 | (returnValue = -1) ifTrue: [ self perror: 'pipe()' ]. 216 | fileDescriptors := Array new: 2. 217 | fileDescriptors at: 1 put: (pipePointer nbUInt32AtOffset: 0). 218 | fileDescriptors at: 2 put: (pipePointer nbUInt32AtOffset: 4). 219 | ^ OSSPipe newWith: fileDescriptors readBlocking: aBoolean. 220 | ] ensure:[ 221 | pipePointer free. 222 | ] 223 | ==================== OLD CODe ======================= 224 | " 225 | 226 | | fileIDsArray | 227 | fileIDsArray := self primCreatePipe. 228 | ^ OSSPipe newWith: fileIDsArray readBlocking: aBoolean. 229 | 230 | ] 231 | 232 | { #category : 'errors' } 233 | OSSUnixSystemAccessor >> perror: aMessage [ 234 | "Prints the errno gloabl variable into the stderr together with aMessage string 235 | and then signal an error" 236 | self primitivePerror: aMessage. 237 | self error: 'Error: ', aMessage,' You may want to check errors in stderr' 238 | ] 239 | 240 | { #category : 'USING FROM OSPROCESS' } 241 | OSSUnixSystemAccessor >> primCreatePipe [ 242 | "Create a pipe, and answer an array of two file handles (SQFile data structures in interp.c) 243 | for the pipe reader and writer." 244 | 245 | 246 | ^ nil 247 | ] 248 | 249 | { #category : 'USING FROM OSPROCESS' } 250 | OSSUnixSystemAccessor >> primForwardSignal: signalNumber toSemaphore: semaphoreIndex [ 251 | "Set a signal handler in the VM which will signal a Smalltalk semaphore at 252 | semaphoreIndex whenever an external signal sigNum is received. Answer the 253 | prior value of the signal handler. If semaphoreIndex is zero, the handler is 254 | unregistered, and the VM returns to its default behavior for handling that 255 | signal. 256 | 257 | The Smalltalk semaphore is expected to be kept at the same index location 258 | indefinitely during the lifetime of a Squeak session. If that is not the case, the 259 | handler must be unregistered prior to unregistering the Smalltalk semaphore." 260 | 261 | 262 | ^ nil 263 | 264 | ] 265 | 266 | { #category : 'USING FROM OSPROCESS' } 267 | OSSUnixSystemAccessor >> primSQFileSetNonBlocking: aSQFileStruct [ 268 | "Pass a struct SQFile on the stack, and call fcntl() to set the file non-blocking." 269 | 270 | 271 | ^ nil 272 | 273 | ] 274 | 275 | { #category : 'USING FROM OSPROCESS' } 276 | OSSUnixSystemAccessor >> primSemaIndexFor: sigNum [ 277 | "Answer the registration index of the semaphore currently associated with the 278 | signal handler for sigNum." 279 | 280 | 281 | ^ nil 282 | 283 | ] 284 | 285 | { #category : 'USING FROM OSPROCESS' } 286 | OSSUnixSystemAccessor >> primSigChldNumber [ 287 | "Integer value corresponding to SIGCHLD" 288 | 289 | 290 | ^ nil 291 | 292 | ] 293 | 294 | { #category : 'USING FROM OSPROCESS' } 295 | OSSUnixSystemAccessor >> primUnixFileNumber: aFileID [ 296 | "Pass a struct SQFile on the stack, and answer the corresponding Unix file number." 297 | 298 | 299 | ^ nil 300 | 301 | ] 302 | 303 | { #category : 'cwd - primitives' } 304 | OSSUnixSystemAccessor >> primitiveChdir: aDirString encoding: encoding [ 305 | | encodingOption | 306 | encodingOption := #optStringEncoding , encoding. 307 | ^ self 308 | ffiCall: #( int chdir(String aDirString) ) 309 | options: { #optStringEncodingMandatory . encodingOption }. 310 | ] 311 | 312 | { #category : 'files - primitives' } 313 | OSSUnixSystemAccessor >> primitiveClose: aFileDescription [ 314 | 315 | ^ self ffiCall: #( int close(int aFileDescription) ) 316 | 317 | ] 318 | 319 | { #category : 'NOT CURRENTLY USED' } 320 | OSSUnixSystemAccessor >> primitiveFdopen: aFileDescription mode: aMode [ 321 | 322 | ^ self ffiCall: #( OSSCFile fdopen(int aFileDescription, String aMode) ) 323 | 324 | ] 325 | 326 | { #category : 'files - primitives' } 327 | OSSUnixSystemAccessor >> primitiveFeof: filePointer [ 328 | 329 | ^ self ffiCall: #( int feof( OSSCFile filePointer) ) 330 | 331 | ] 332 | 333 | { #category : 'files - primitives' } 334 | OSSUnixSystemAccessor >> primitiveFflush: file [ 335 | 336 | ^ self ffiCall: #( int fflush( OSSCFile file) ) 337 | 338 | ] 339 | 340 | { #category : 'NOT CURRENTLY USED' } 341 | OSSUnixSystemAccessor >> primitiveFgetsInto: bufferPointer size: size file: file [ 342 | "Not directly used for the moment but could be useful to test the reading without the 343 | SCAttachableFileStream using a code like this: 344 | 345 | buffer := NativeBoost allocate: 1001. 346 | (self primitiveFgetsInto: buffer size: 1001 file: popenFile). 347 | self primitivePerror: 'fgets()'. 348 | buffer byteAt: 1001 put: 0. 349 | string := buffer readString. 350 | buffer free. 351 | string inspect. 352 | 353 | " 354 | 355 | ^ self ffiCall: #( String fgets(void* bufferPointer, int size, OSSCFile file) ) 356 | 357 | ] 358 | 359 | { #category : 'files - primitives' } 360 | OSSUnixSystemAccessor >> primitiveFileno: file [ 361 | 362 | ^ self ffiCall: #( int fileno( OSSCFile file) ) 363 | 364 | ] 365 | 366 | { #category : 'cwd - primitives' } 367 | OSSUnixSystemAccessor >> primitiveGetcwd: buffer size: size [ 368 | 369 | ^ self ffiCall: #( String getcwd(char *buffer, int size) ) 370 | 371 | ] 372 | 373 | { #category : 'NOT CURRENTLY USED' } 374 | OSSUnixSystemAccessor >> primitiveGetdtablesize [ 375 | 376 | ^ self ffiCall: #( int getdtablesize(void) ) 377 | 378 | 379 | ] 380 | 381 | { #category : 'NOT CURRENTLY USED' } 382 | OSSUnixSystemAccessor >> primitiveGetenv: variableName [ 383 | 384 | ^ self ffiCall: #( char * getenv(char* variableName) ) 385 | ] 386 | 387 | { #category : 'general' } 388 | OSSUnixSystemAccessor >> primitiveGetpid [ 389 | 390 | ^ self ffiCall: #( int getpid(void) ) 391 | 392 | 393 | ] 394 | 395 | { #category : 'signals - primitives' } 396 | OSSUnixSystemAccessor >> primitiveKill: aPid signal: aSignal [ 397 | 398 | ^ self ffiCall: #( int kill(int aPid, int aSignal) ) 399 | 400 | ] 401 | 402 | { #category : 'errors - primitives' } 403 | OSSUnixSystemAccessor >> primitivePerror: anErrorString [ 404 | 405 | ^ self ffiCall: #( void perror(String anErrorString) ) 406 | 407 | ] 408 | 409 | { #category : 'NOT CURRENTLY USED' } 410 | OSSUnixSystemAccessor >> primitivePipe: pipePointer [ 411 | 412 | ^ self ffiCall: #( int pipe(void* pipePointer) ) 413 | ] 414 | 415 | { #category : 'errors - primitives' } 416 | OSSUnixSystemAccessor >> primitiveStrerror: errorNumber [ 417 | 418 | ^ self ffiCall: #( String strerror( int errorNumber) ) 419 | 420 | ] 421 | 422 | { #category : 'NOT CURRENTLY USED' } 423 | OSSUnixSystemAccessor >> primitiveSysconf: aNumber [ 424 | 425 | ^ self ffiCall: #( long sysconf(int aNumber) ) 426 | 427 | 428 | ] 429 | 430 | { #category : 'system - primitives' } 431 | OSSUnixSystemAccessor >> primitiveSystem: commandString [ 432 | ^ self ffiCall: #(int system(char* commandString) ) 433 | 434 | ] 435 | 436 | { #category : 'USING FROM OSPROCESS' } 437 | OSSUnixSystemAccessor >> restoreSigChld [ 438 | "Unset a SIGCHLD signal handler and unregister the Smalltalk semaphore. 439 | Answer the unregistered Semaphore, or nil if unable to restore the signal 440 | (possibly because no handler had been set)." 441 | 442 | ^ self restoreSignal: self primSigChldNumber 443 | 444 | ] 445 | 446 | { #category : 'USING FROM OSPROCESS' } 447 | OSSUnixSystemAccessor >> restoreSignal: signalNumber [ 448 | "Unset a signal handler and unregister the Smalltalk semaphore. Answer 449 | the unregistered Semaphore, or nil if unable to restore the signal (possibly 450 | because no handler had been set)." 451 | 452 | | semaphoreIndex sema | 453 | semaphoreIndex := self primSemaIndexFor: signalNumber. 454 | semaphoreIndex ifNotNil: 455 | [sema := Smalltalk externalObjects at: semaphoreIndex ifAbsent: []. 456 | sema ifNotNil: 457 | [self primForwardSignal: signalNumber toSemaphore: nil. 458 | Smalltalk unregisterExternalObject: sema]]. 459 | ^ sema 460 | 461 | ] 462 | 463 | { #category : 'sizeof' } 464 | OSSUnixSystemAccessor >> sizeOfInt [ 465 | 466 | ^ FFIExternalType sizeOf: #long 467 | ] 468 | 469 | { #category : 'sizeof' } 470 | OSSUnixSystemAccessor >> sizeOfPointer [ 471 | 472 | ^ FFIExternalType pointerSize 473 | 474 | 475 | 476 | ] 477 | 478 | { #category : 'errors' } 479 | OSSUnixSystemAccessor >> strerror: aReturnValue message: aMessage [ 480 | "Get the string description of the error numnber aReturnValue and signal 481 | and error with such a description together with aMessage string" 482 | | internalError | 483 | internalError := self primitiveStrerror: aReturnValue. 484 | self error: 'Error: ', aMessage, ', code: ', aReturnValue asString, ', description: ', internalError 485 | ] 486 | 487 | { #category : 'system' } 488 | OSSUnixSystemAccessor >> system: aCommandString [ 489 | "Executes aCommandString in the OS via the system() call. Only used for testing." 490 | | returnValue | 491 | returnValue := self primitiveSystem: aCommandString. 492 | (returnValue = -1) ifTrue: [ 493 | self perror: 'system()' 494 | ]. 495 | ^ returnValue 496 | ] 497 | -------------------------------------------------------------------------------- /repository/OSSubprocess/OSSVMProcess.class.st: -------------------------------------------------------------------------------- 1 | " 2 | OSSVMProcess represents the operating system process in which this Pharo VM is currently running. OSSVMProcess has a unique instance accessed via #vmProcess and it also uses a unique instance of OSSUnixSystemAccessor which provides access to the external operating system. 3 | 4 | OSSVMProcess can answer some information about the OS process running the VM, such as running PID, children, etc etc. More can be added later. 5 | 6 | Another important task of this class is to keep track of all the launched children processes (instances of OSSUnixSubprocess). Whenever a process is started it's registered in OSSVMProcess and unregister in certain scenarios (see senders of #unregisterChildProcess:). We keep a list of all our children, and ocasionally prune all those that have already been exited. 7 | 8 | This class takes care of running what we call the ""child watcher"" which is basically a way to monitor children status and collect exit code when they finish. This also guarantees not to let zombies process (a child whose parent did not collected child exit status). Basically, we use a SIGCHLD handler to capture a child death. For more details, see method #initializeChildWatcher. 9 | 10 | " 11 | Class { 12 | #name : 'OSSVMProcess', 13 | #superclass : 'Object', 14 | #instVars : [ 15 | 'accessProtect', 16 | 'childProcessList', 17 | 'systemAccessor', 18 | 'pid', 19 | 'childListTreshold', 20 | 'sessionID', 21 | 'mutexForCwd', 22 | 'sigChldSemaphore', 23 | 'childWatcher', 24 | 'earlyFinishedProcesses' 25 | ], 26 | #classVars : [ 27 | 'VMProcess' 28 | ], 29 | #pools : [ 30 | 'LibCErrnoSharedPool', 31 | 'LibCWaitSharedPool' 32 | ], 33 | #category : 'OSSubprocess', 34 | #package : 'OSSubprocess' 35 | } 36 | 37 | { #category : 'initialize - release' } 38 | OSSVMProcess class >> initialize [ 39 | 40 | self initializeVMProcessInstance. 41 | SessionManager default registerToolClassNamed: self name 42 | ] 43 | 44 | { #category : 'initialize - release' } 45 | OSSVMProcess class >> initializeVMProcessInstance [ 46 | 47 | VMProcess ifNotNil: [ 48 | VMProcess finalizePreviousSession. 49 | VMProcess := nil ]. 50 | Smalltalk os isWindows ifFalse: [ 51 | VMProcess := self basicNew initialize ] 52 | ] 53 | 54 | { #category : 'instance creation' } 55 | OSSVMProcess class >> new [ 56 | 57 | self error: 'Only one instance of OSSVMProcess or any of its subclasses should exist in the image. Use #vmProcess to obtain the singleton instance.'. 58 | 59 | ] 60 | 61 | { #category : 'system startup' } 62 | OSSVMProcess class >> shutDown: quitting [ 63 | self vmProcess ifNotNil: [:a | a shutDown: quitting] 64 | ] 65 | 66 | { #category : 'system startup' } 67 | OSSVMProcess class >> startUp: resuming [ 68 | 69 | resuming ifTrue: [ self initializeVMProcessInstance ] 70 | ] 71 | 72 | { #category : 'OS Process' } 73 | OSSVMProcess class >> tryToDisableOSProcessSigchldHandler [ 74 | 75 | self flag: #fixIt. "hack!!!!" 76 | Smalltalk at: #OSProcess ifPresent: [ 77 | (Smalltalk at: #OSProcess) thisOSProcess processAccessor restoreSigChld. 78 | (Smalltalk at: #OSProcess) thisOSProcess processAccessor grimReaperProcess terminate. 79 | (Smalltalk at: #ThisOSProcess) shutDown: true. 80 | Smalltalk removeFromShutDownList: (Smalltalk at: #ThisOSProcess). 81 | Smalltalk removeFromStartUpList: (Smalltalk at: #ThisOSProcess). 82 | ]. 83 | ] 84 | 85 | { #category : 'accessing' } 86 | OSSVMProcess class >> vmProcess [ 87 | "Answer a single instance representing the OS process in 88 | which this Smalltalk VM and image is executing." 89 | 90 | ^ VMProcess 91 | ] 92 | 93 | { #category : 'childs management' } 94 | OSSVMProcess >> activeChildren [ 95 | "Answer child processes which are currently believed to be running." 96 | 97 | ^ accessProtect critical: [ childProcessList select: [ :process | process isRunning ] ]. 98 | 99 | ] 100 | 101 | { #category : 'childs management' } 102 | OSSVMProcess >> allMyChildren [ 103 | 104 | ^ childProcessList 105 | ] 106 | 107 | { #category : 'child watching' } 108 | OSSVMProcess >> checkFinishedChildren [ 109 | "Does a waitpid() with the flag WNOHANG which makes the system call to answer immediatly rather than waiting until child has exited. 110 | Answers nil if child has not yet exited or the exit status if it has. 111 | 112 | http://man7.org/linux/man-pages/man2/waitpid.2.html 113 | waitpid man's page is ambiguous with respect of the usage of the WNOHANG option. 114 | It looks like waitpid ignores the first argument if WNOHANG is specified, and returns with ANY child process id. 115 | This means that, in combination with the previous issue, it may happen that calling waitpid for process X will unregister process Y, what will make fail a subsequent call to waitpid from Y. 116 | " 117 | 118 | | waitedChildren childrenSize | 119 | "Skip checking if we have no children" 120 | waitedChildren := 0. 121 | childrenSize := self activeChildren size. 122 | [ waitedChildren < childrenSize ] 123 | whileTrue: [ | statusPointer | 124 | [ | status returnValue | 125 | statusPointer := ExternalAddress allocate: systemAccessor sizeOfInt. 126 | returnValue := self primitiveWaitpid: -1 statusPointer: statusPointer options: WNOHANG. 127 | 128 | "If return value is 0 then there are no more changes, we can exit" 129 | returnValue = 0 130 | ifTrue: [ ^ self ]. 131 | 132 | "Only throw error in case it is an error other than no childs (represented as return -1 and errno=ECHILD)" 133 | returnValue = -1 134 | ifTrue: [ systemAccessor perror: 'waitpid()' ]. 135 | waitedChildren := waitedChildren + 1. 136 | status := statusPointer platformLongAt: 1. 137 | self updateChildProcessWithId: returnValue withStatus: status ] 138 | ensure: [ statusPointer free ] ] 139 | ] 140 | 141 | { #category : 'childs management' } 142 | OSSVMProcess >> childPids [ 143 | 144 | ^ childProcessList collect: [ :process | process pid ] 145 | 146 | ] 147 | 148 | { #category : 'accessing' } 149 | OSSVMProcess >> earlyFinishedProcesses [ 150 | 151 | ^ earlyFinishedProcesses ifNil: [ earlyFinishedProcesses := Dictionary new ] 152 | ] 153 | 154 | { #category : 'childs management' } 155 | OSSVMProcess >> exitedChildren [ 156 | "Answer child processes which have exited and are no longer running." 157 | 158 | ^ accessProtect critical: [ childProcessList select: [ :process | process isComplete ]]. 159 | 160 | ] 161 | 162 | { #category : 'library path' } 163 | OSSVMProcess >> ffiLibraryName [ 164 | ^ LibC 165 | ] 166 | 167 | { #category : 'updating' } 168 | OSSVMProcess >> finalizePreviousSession [ 169 | "This method is likely called at image startup and it's job is to finalize 170 | stuff related to the previous run and let everything clean so that 171 | the unique instance vmProcess of OSSVMProcess can be initialized correctly at startup. " 172 | 173 | childWatcher ifNotNil: [ 174 | childWatcher isTerminated ifFalse: [ childWatcher terminate ]. 175 | childWatcher := nil ]. 176 | sigChldSemaphore ifNotNil: [ 177 | self systemAccessor restoreSigChld. 178 | sigChldSemaphore := nil ]. 179 | "To understand why the #stopWaiting, first read the comment of #shutDown:. 180 | It could happen that when the shutDown happened, the child process was in 181 | the wait of #waitForExitPollingEvery:doing:. Therefore, until the next cycle 182 | of the loop it won't do the queryExitStatus. So we may still have this 183 | problem in image startup. So just in case we run it too in the startup code." 184 | self activeChildren do: [ :each | each stopWaiting ] 185 | ] 186 | 187 | { #category : 'initialize - release' } 188 | OSSVMProcess >> initialize [ 189 | "Set my instance variables to reflect the state of the OS process in which 190 | this Smalltalk virtual machine is. executing." 191 | Smalltalk os isWindows ifTrue: [ ^ self ]. "Cannot be initialized nor used on Windows." 192 | 193 | accessProtect := Semaphore forMutualExclusion. 194 | mutexForCwd := Semaphore forMutualExclusion. 195 | self initializeAllMyChildren. 196 | systemAccessor := OSSUnixSystemAccessor forVMProcess. 197 | pid := systemAccessor getPid. 198 | childListTreshold := 20. "Once child list gets bigger than this number, we delete all exited processes" 199 | self initializeSessionID. 200 | self initializeSignalHandlers. 201 | self initializeChildWatcher. 202 | ] 203 | 204 | { #category : 'initialize - release' } 205 | OSSVMProcess >> initializeAllMyChildren [ 206 | "Use a Dictionary if process identifiers are unique. On Windows, the 207 | process ID is not unique, so use an OrderedCollection instead." 208 | 209 | ^ childProcessList := OrderedCollection new 210 | 211 | ] 212 | 213 | { #category : 'child watching' } 214 | OSSVMProcess >> initializeChildWatcher [ 215 | "This is a process which waits for the death of a child processes. Use SIGCHLD events rather than a Delay to poll." 216 | 217 | | processSynchronizationDelay | 218 | processSynchronizationDelay := Delay forMilliseconds: 30. 219 | childWatcher ifNil: [ 220 | childWatcher := [ [ 221 | "OSProcess authors suspected that there were various ways in which OS signals 222 | could be missed under conditions of heavy load. For that reason, we use 223 | #waitTimeoutMSecs: with the semaphore, so that if a signal is missed, 224 | we time out and rescan occasionally anyway (#updateActiveChildrenAndNotifyDead 225 | sends queryExitStatus which sends waitpid() )" 226 | 227 | SystemVersion current major < 12 ifTrue: [ 228 | self sigChldSemaphore waitTimeoutMSecs: 1000 229 | ] ifFalse: [ 230 | self sigChldSemaphore waitTimeoutMilliseconds: 1000 231 | ]. 232 | 233 | processSynchronizationDelay wait. "Avoids lost signals in heavy process switching" 234 | self checkFinishedChildren ] repeat 235 | ] newProcess priority: Processor highIOPriority. 236 | 237 | childWatcher resume. 238 | "name selected to look reasonable in the process browser" 239 | childWatcher name: 240 | ((ReadStream on: childWatcher hash asString) next: 5) 241 | , ': the OSSubprocess child watcher' ] 242 | ] 243 | 244 | { #category : 'initialize - release' } 245 | OSSVMProcess >> initializeSessionID [ 246 | | oldFile | 247 | self flag: #fixMe. 248 | "grrr I need the sessionID (first int of the SQFile). .. there is no primitive to get it. Since it is the same for all files 249 | lets try to grab it from a file we know there will be always there: the image file." 250 | oldFile := OldStandardFileStream oldFileNamed: Smalltalk image imagePath. 251 | sessionID := oldFile basicFileID copy first: (self systemAccessor sizeOfInt). 252 | oldFile close. 253 | ] 254 | 255 | { #category : 'initialize - release' } 256 | OSSVMProcess >> initializeSignalHandlers [ 257 | "#sigChldSemaphore will lazily create and register the semaphore if needed" 258 | self sigChldSemaphore. 259 | 260 | ] 261 | 262 | { #category : 'cwd' } 263 | OSSVMProcess >> lockCwdWithValue: cwdNewValue encoding: encoding during: aBlock [ 264 | "This method is a complete hack in order to support a #cmd: option in OSSUnixSubprocess. 265 | OSSUnixSubprocess relies in posix_spawn() family of functions to spwan processes in the OS, 266 | and these functions do not allow specifying a starting working directory for the child process. 267 | However, this is sometimes needed by subprocess. 268 | Therefore, we propose this hack. Basically, we change the current directory of the parent process (vmProcess) 269 | BEFORE launching the subprocess. When the child is launched, it inherits the working directory of the parent. 270 | As soon as the child was launched, we rollback and put back the original working directory in the parent. 271 | Because if this, it's very much likely that aBlock represents the launching of a child process. 272 | 273 | mutexForCwd is needed because we may have multiple children at the same time trying to change working 274 | directory (not thread safe..). So with mutexForCwd we sincronize this. 275 | 276 | Forking with userInterruptPriority is useful just in case there could be other Smalltalk process 277 | using another code, trying to ALSO change the working directory (very very unlikely). So at least with 278 | userInterruptPriority we make sure that we a higher priority than the rest of the normal user code 279 | and so we minimize that problem. 280 | 281 | " 282 | 283 | | completed | 284 | cwdNewValue asFileReference exists ifFalse: [ ^ self error: 'The directory: ', cwdNewValue, ' does not exist' ]. 285 | completed := Semaphore new. 286 | [ 287 | | oldCwd | 288 | oldCwd := self systemAccessor getcwd. 289 | [ 290 | self systemAccessor chdir: cwdNewValue encoding: encoding. 291 | mutexForCwd critical: aBlock. 292 | ] 293 | ensure: [ 294 | self systemAccessor chdir: oldCwd encoding: encoding. 295 | completed signal. 296 | ] 297 | ] forkAt: Processor userInterruptPriority. 298 | completed wait. 299 | 300 | ] 301 | 302 | { #category : 'accessing' } 303 | OSSVMProcess >> pid [ 304 | ^ pid 305 | ] 306 | 307 | { #category : 'child watching' } 308 | OSSVMProcess >> primitiveWaitpid: aProcessId statusPointer: statusPointer options: optionBits [ 309 | 310 | ^ self ffiCall: #( int waitpid(int aProcessId, void* statusPointer, int optionBits) ) 311 | ] 312 | 313 | { #category : 'childs management' } 314 | OSSVMProcess >> pruneExitedChildrenAfter: size [ 315 | "Limit the size of the child process registry. Select the last entries, and unregister 316 | them if they are no longer active." 317 | 318 | (accessProtect critical: [childProcessList allButFirst: size]) 319 | do: [ :aProcess | 320 | aProcess isComplete ifTrue: [ self unregisterChildProcess: aProcess ]] 321 | 322 | ] 323 | 324 | { #category : 'childs management' } 325 | OSSVMProcess >> registerChildProcess: anOSProcess [ 326 | "Unregister anOSProcess, and trim the child process registry to prevent excessive 327 | accumulation of exited children. 328 | 329 | If the process finished before this registration, set it the exit status. 330 | Otherwise, register it" 331 | 332 | accessProtect critical: [ 333 | self earlyFinishedProcesses 334 | at: anOSProcess pid 335 | ifPresent: [ :exitStatus | 336 | anOSProcess setExitStatus: exitStatus. 337 | self earlyFinishedProcesses removeKey: anOSProcess pid ] 338 | ifAbsent: [ childProcessList addFirst: anOSProcess ] ]. 339 | self pruneExitedChildrenAfter: childListTreshold. 340 | ^ anOSProcess 341 | 342 | ] 343 | 344 | { #category : 'accessing' } 345 | OSSVMProcess >> sessionID [ 346 | "The sessionID is something internal to the VM and it's used 347 | as part of the fileID structure (sqFile) of StandardFileStream. 348 | We use it for some file operations" 349 | ^ sessionID 350 | ] 351 | 352 | { #category : 'system startup & shutdown' } 353 | OSSVMProcess >> shutDown: quitting [ 354 | "If we have a process that do not stop automatically (like a tail -f) and it runs 355 | with #fork (at Smalltalk level) then that process will be continue running 356 | after the image has stopped and started again. 357 | If this process continues running, it may be waiting via a delay polling 358 | and that will throw an error since waitpid() will fail since the parent process 359 | (the VM process) is NOT the parent anymore of the child process. 360 | And so.if the process fails, it makes the system startup to fail and we cannot 361 | open the image anymore. See https://github.com/marianopeck/OSSubprocess/issues/12 362 | So... to solve this we simply make all active childs to stop waiting so that the 363 | next startup of the image has no problem. 364 | 365 | " 366 | quitting ifTrue: [ self activeChildren do: [ :each | each shutDown: quitting ] ]. 367 | ] 368 | 369 | { #category : 'child watching' } 370 | OSSVMProcess >> sigChldSemaphore [ 371 | "Answer the value of sigChldSemaphore. 372 | If nil, then register and create a semaphore to be signaled upon SIGCHLD. 373 | See #forwardSigChld for more details. " 374 | 375 | ^ sigChldSemaphore ifNil: [sigChldSemaphore := self systemAccessor forwardSigChld]. 376 | 377 | ] 378 | 379 | { #category : 'accessing' } 380 | OSSVMProcess >> systemAccessor [ 381 | ^ systemAccessor 382 | ] 383 | 384 | { #category : 'childs management' } 385 | OSSVMProcess >> unregisterChildProcess: anOSProcess [ 386 | 387 | "Unregister anOSProcess from the list of children" 388 | 389 | accessProtect critical: [childProcessList remove: anOSProcess ifAbsent: [] ]. 390 | ^ anOSProcess 391 | 392 | ] 393 | 394 | { #category : 'child watching' } 395 | OSSVMProcess >> updateChildProcessWithId: aChildPid withStatus: status [ 396 | 397 | | childProcess | 398 | childProcess := self activeChildren 399 | detect: [ :child | child pid = aChildPid ] 400 | ifNone: [ ^ self earlyFinishedProcesses at: aChildPid put: status ]. 401 | childProcess setExitStatus: status. 402 | childProcess processHasExitNotification. 403 | ] 404 | -------------------------------------------------------------------------------- /repository/OSSubprocess/OldStandardFileStream.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'OldStandardFileStream' } 2 | 3 | { #category : '*OSSubprocess' } 4 | OldStandardFileStream >> atEndOfFile [ 5 | "Answer whether the receiver is at its end based on the result of the last read operation. This uses feof() to test the underlying file stream status, and can be used as an alternative to #atEnd, which does not properly report end of file status for an OSPipe. 6 | 7 | Answer whether the file represented by #getFilePointerAsCFile is at end of file, as determined by a call to feof(). This is different from StandardFileStream>>primAtEnd: which answers true if the file pointer is at the end of the file, but which does not call feof() to determine that an end of file condition has occurred. The difference is significant if aSqFileStruct represents a pipe. Another case where the difference is significant is when using StandardFileStream to communicate with a child process since the SQFile will not automatically be updated if some other process has changed the actual size of the file. 8 | " 9 | 10 | ^ fileID isNil or: [ self systemAccessor feof: self getFilePointerAsCFile ] 11 | 12 | ] 13 | 14 | { #category : '*OSSubprocess' } 15 | OldStandardFileStream >> basicFileID [ 16 | ^ fileID 17 | ] 18 | 19 | { #category : '*OSSubprocess' } 20 | OldStandardFileStream >> getFilePointerAsCFile [ 21 | 22 | | pointerSize secondFieldStart secondFieldEnd | 23 | pointerSize := FFIExternalType pointerSize. 24 | secondFieldStart := pointerSize + 1. 25 | secondFieldEnd := secondFieldStart + pointerSize - 1. 26 | ^ OSSCFile new 27 | setHandle: (ExternalData 28 | fromHandle: ((fileID copyFrom: secondFieldStart to: secondFieldEnd) asExternalPointer ) 29 | type: ExternalType void asPointerType); 30 | yourself 31 | 32 | 33 | 34 | 35 | ] 36 | 37 | { #category : '*OSSubprocess' } 38 | OldStandardFileStream >> ossIsPipe [ 39 | ^ false 40 | ] 41 | 42 | { #category : '*OSSubprocess' } 43 | OldStandardFileStream >> systemAccessor [ 44 | ^ OSSVMProcess vmProcess systemAccessor 45 | ] 46 | 47 | { #category : '*OSSubprocess' } 48 | OldStandardFileStream >> upToEndOfFile [ 49 | "Answer a subcollection from the current access position through the last element of the receiver. Use #atEndOfFile to determine end of file status with feof(), required for reliable end of file test on OS pipes or in files that could have been written by another (child) process different than the VM process." 50 | 51 | 52 | | newStream buffer | 53 | self closed 54 | ifTrue: [ self error: 'File already closed' ] 55 | ifFalse: [ 56 | buffer := buffer1 species new: 1000. 57 | newStream := WriteStream on: (buffer1 species new: 100). 58 | [self atEndOfFile] whileFalse: [newStream nextPutAll: (self nextInto: buffer)]. 59 | ^ newStream contents 60 | ] 61 | ] 62 | -------------------------------------------------------------------------------- /repository/OSSubprocess/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'OSSubprocess' } 2 | -------------------------------------------------------------------------------- /repository/OldFileStream/ManifestDeprecatedFileStream.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Deprecated package including the old file stream implementations 3 | " 4 | Class { 5 | #name : 'ManifestDeprecatedFileStream', 6 | #superclass : 'PackageManifest', 7 | #category : 'OldFileStream-Manifest', 8 | #package : 'OldFileStream', 9 | #tag : 'Manifest' 10 | } 11 | 12 | { #category : 'deprecation' } 13 | ManifestDeprecatedFileStream class >> isDeprecated [ 14 | ^true 15 | ] 16 | -------------------------------------------------------------------------------- /repository/OldFileStream/OldFileExistsException.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Notify when file exists 3 | " 4 | Class { 5 | #name : 'OldFileExistsException', 6 | #superclass : 'FileException', 7 | #instVars : [ 8 | 'fileClass' 9 | ], 10 | #category : 'OldFileStream-Exceptions', 11 | #package : 'OldFileStream', 12 | #tag : 'Exceptions' 13 | } 14 | 15 | { #category : 'exceptioninstantiator' } 16 | OldFileExistsException class >> fileName: aFileName fileClass: aClass [ 17 | ^ self new 18 | fileName: aFileName; 19 | fileClass: aClass 20 | ] 21 | 22 | { #category : 'deprecation' } 23 | OldFileExistsException class >> isDeprecated [ 24 | ^true 25 | ] 26 | 27 | { #category : 'exceptiondescription' } 28 | OldFileExistsException >> defaultAction [ 29 | "The default action taken if the exception is signaled." 30 | 31 | ^ UIManager default fileExistsDefaultAction: self 32 | 33 | ] 34 | 35 | { #category : 'accessing' } 36 | OldFileExistsException >> file [ 37 | 38 | ^ self fileClass fileNamed: fileName 39 | ] 40 | 41 | { #category : 'accessing' } 42 | OldFileExistsException >> fileClass [ 43 | ^ fileClass ifNil: [OldStandardFileStream] 44 | ] 45 | 46 | { #category : 'accessing' } 47 | OldFileExistsException >> fileClass: aClass [ 48 | fileClass := aClass 49 | ] 50 | -------------------------------------------------------------------------------- /repository/OldFileStream/OldFileStream.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I'm a deprecated class. 3 | Since the version 5, Pharo provides a new file streams API that makes the old one based on classes like FileStream or MultiByteBinaryOrTextStream deprecated. 4 | Pharo 7 makes the next important steps and removes usages of the old API from the kernel. 5 | 6 | What you should remember: 7 | - use file references as entry points to file streams 8 | - DO NOT USE FileStream class 9 | - 'file.txt' asFileReference readStream and similar methods now return an instance of ZnCharacterReadStream instead of MultiByteFileStream 10 | - 'file.txt' asFileReference writeStream and similar methods now return an instance of ZnCharacterWriteStream instead of MultiByteFileStream 11 | - the new API has a clearer separation between binary and text files 12 | 13 | 1. Basic Files 14 | By default files are binary. Not buffered. 15 | 16 | Read UTF-8 text from an existing file 17 | Obsolete code: 18 | FileStream readOnlyFileNamed: '1.txt' do: [ :stream | 19 | stream upToEnd ]. 20 | New code: 21 | (File named: 'name') readStream. 22 | (File named: 'name') readStreamDo: [ :stream | ‚Ķ ]. 23 | '1.txt' asFileReference readStreamDo: [ :stream | 24 | stream upToEnd ]. 25 | 26 | 2. Encoding 27 | To add encoding, wrap a stream with a corresponding ZnCharacterRead/WriteStream. 28 | ‚ÄúReading‚Äù 29 | utf8Encoded := ZnCharacterReadStream on: aBinaryStream encoding: ‚Äòutf8‚Äô. 30 | utf16Encoded := ZnCharacterReadStream on: aBinaryStream encoding: ‚Äòutf16‚Äô. 31 | ‚ÄúWriting‚Äù 32 | utf8Encoded := ZnCharacterWriteStream on: aBinaryStream encoding: ‚Äòutf8‚Äô. 33 | utf16Encoded := ZnCharacterWriteStream on: aBinaryStream encoding: ‚Äòutf16‚Äô. 34 | 35 | Force creation of a new file and write a UTF-8 text 36 | Obsolete code: 37 | FileStream forceNewFileNamed: '1.txt' do: [ :stream | stream nextPutAll: 'a ‚↠b' ]. 38 | New code: 39 | (File named: ‚Äòname‚Äô) writeStream. 40 | (File named: ‚Äòname‚Äô) writeStreamDo: [ :stream | ‚Ķ ]. 41 | '1.txt' asFileReference ensureDelete; 42 | writeStreamDo: [ :stream | stream nextPutAll: 'a ‚↠b' ]. 43 | 44 | Get all content of existing UTF-8 file 45 | Obsolete code: 46 | (FileStream readOnlyFileNamed: '1.txt') contentsOfEntireFile. 47 | New code: 48 | '1.txt' asFileReference readStream upToEnd. 49 | 50 | 3. Buffering 51 | To add buffering, wrap a stream with a corresponding ZnBufferedRead/WriteStream. 52 | bufferedReadStream := ZnBufferedReadStream on: aStream. 53 | bufferedWriteStream := ZnBufferedWriteStream on: aStream. 54 | It is in general better to buffer the reading on the binary file and apply the encoding on the buffer in memory than the other way around. See 55 | [file := Smalltalk sourcesFile fullName. 56 | (File named: file) readStreamDo: [ :binaryFile | 57 | (ZnCharacterReadStream on: (ZnBufferedReadStream on: binaryFile) encoding: ‚Äòutf8‚Äô) upToEnd 58 | ]] timeToRun. ‚Äú0:00:00:09.288‚Äù 59 | [file := Smalltalk sourcesFile fullName. 60 | (File named: file) readStreamDo: [ :binaryFile | 61 | (ZnBufferedReadStream on: (ZnCharacterReadStream on: binaryFile encoding: ‚Äòutf8‚Äô)) upToEnd 62 | ]] timeToRun. ‚Äú0:00:00:14.189‚Äù 63 | 64 | The MultiByteFileStream was buffered. If you create a stream using the expression 65 | 'file.txt' asFileReference readStream. 66 | then the ZnCharacterReadStream is not created directly on top of the stream but on top of a buffered stream that uses the file stream internally. 67 | 68 | If you create a ZnCharacterReadStream directly on the file stream, then the characters from the file are read one by one which may be about ten times slower! 69 | ZnCharacterReadStream on: (File openForReadFileNamed: 'file.txt'). 70 | 71 | 4. File System 72 | By default, file system files are buffered and utf8 encoded to keep backwards compatibility. 73 | ‚Äòname‚Äô asFileReference readStreamDo: [ :bufferedUtf8Stream | ‚Ķ ]. 74 | ‚Äòname‚Äô asFileReference writeStreamDo: [ :bufferedUtf8Stream | ‚Ķ ]. 75 | FileStream also provides access to plain binary files using the #binaryRead/WriteStream messages. Binary streams are buffered by default too. 76 | ‚Äòname‚Äô asFileReference binaryReadStreamDo: [ :bufferedBinaryStream | ‚Ķ ]. 77 | ‚Äòname‚Äô asFileReference binaryWriteStreamDo: [ :bufferedBinaryStream | ‚Ķ ]. 78 | If you want a file with another encoding (to come in the PR https://github.com/pharo-project/pharo/pull/1134), you can specify it while obtaining the stream: 79 | ‚Äòname‚Äô asFileReference 80 | readStreamEncoded: ‚Äòutf16‚Äô 81 | do: [ :bufferedUtf16Stream | ‚Ķ ]. 82 | ‚Äòname‚Äô asFileReference 83 | writeStreamEncoded: ‚Äòutf8‚Äô 84 | do: [ :bufferedUtf16Stream | ‚Ķ ]. 85 | 86 | Force creation of a new file and write binary data into it 87 | Obsolete code: 88 | (FileStream forceNewFileNamed: '1.bin') 89 | binary; 90 | nextPutAll: #[1 2 3]. 91 | New code: 92 | '1.bin' asFileReference ensureDelete; 93 | binaryWriteStreamDo: [ :stream | stream nextPutAll: #[1 2 3] ]. 94 | 95 | Read binary data from an existing file 96 | Obsolete code: 97 | (FileStream readOnlyFileNamed: '1.bin') binary; contentsOfEntireFile. 98 | New code: 99 | '1.bin' asFileReference binaryReadStream upToEnd. 100 | 101 | Force creation of a new file with a different encoding 102 | Obsolete code: 103 | FileStream forceNewFileNamed: '2.txt' do: [ :stream | 104 | stream converter: (TextConverter newForEncoding: 'cp-1250'). 105 | stream nextPutAll: 'P≈ô√≠li≈° ≈ælu≈•ouƒçk√Ω k≈Ø≈à √∫pƒõl ƒè√°belsk√© √≥dy.' ]. 106 | New code: 107 | ('2.txt' asFileReference) ensureDelete; 108 | writeStreamEncoded: 'cp-1250' do: [ :stream | 109 | stream nextPutAll: 'P≈ô√≠li≈° ≈ælu≈•ouƒçk√Ω k≈Ø≈à √∫pƒõl ƒè√°belsk√© √≥dy.' ]. 110 | 111 | Read encoded text from an existing file 112 | Obsolete code: 113 | FileStream readOnlyFileNamed: '2.txt' do: [ :stream | 114 | stream converter: (TextConverter newForEncoding: 'cp-1250'). 115 | stream upToEnd ]. 116 | New code: 117 | ('2.txt' asFileReference) 118 | readStreamEncoded: 'cp-1250' do: [ :stream | 119 | stream upToEnd ]. 120 | 121 | Write a UTF-8 text to STDOUT 122 | Obsolete code: 123 | FileStream stdout nextPutAll: 'a ‚↠b'; lf. 124 | New code: 125 | (ZnCharacterWriteStream on: Stdio stdout) 126 | nextPutAll: 'a ‚↠b'; lf; 127 | flush. 128 | 129 | Write CP-1250 encoded text to STDOUT 130 | Obsolete code: 131 | FileStream stdout 132 | converter: (TextConverter newForEncoding: 'cp-1250'); 133 | nextPutAll: 'P≈ô√≠li≈° ≈ælu≈•ouƒçk√Ω k≈Ø≈à √∫pƒõl ƒè√°belsk√© √≥dy.'; lf. 134 | New code: 135 | (ZnCharacterWriteStream on: Stdio stdout encoding: 'cp1250') 136 | nextPutAll: 'P≈ô√≠li≈° ≈ælu≈•ouƒçk√Ω k≈Ø≈à √∫pƒõl ƒè√°belsk√© √≥dy.'; lf; 137 | flush. 138 | 139 | Read a UTF-8 text from STDIN 140 | CAUTION: Following code will stop your VM until an input on STDIN will be provided! 141 | Obsolete code: 142 | FileStream stdin upTo: Character lf. 143 | New code: 144 | (ZnCharacterReadStream on: Stdio stdin) upTo: Character lf. 145 | Write binary data to STDOUT 146 | obsolete code 147 | FileStream stdout 148 | binary 149 | nextPutAll: #[80 104 97 114 111 10 ]. 150 | New code: 151 | Stdio stdout 152 | nextPutAll: #[80 104 97 114 111 10 ]. 153 | 154 | Read binary data from STDIN 155 | CAUTION: Following code will stop your VM until an input on STDIN will be provided! 156 | Obsolete code: 157 | FileStream stdin binary upTo: 10. 158 | New code: 159 | Stdio stdin upTo: 10. 160 | 161 | Positionable streams 162 | The message #position: always works on the binary level, not on the character level. 163 | '1.txt' asFileReference readStreamDo: [ :stream | 164 | stream position: 4. 165 | stream upToEnd ]. 166 | This will lead to an error (ZnInvalidUTF8: Illegal leading byte for UTF-8 encoding) in case of the file created above because we set the position into the middle of a UTF-8 encoded character. To be safe, you need to read the file from the beginning. 167 | '1.txt' asFileReference readStreamDo: [ :stream | 168 | 3 timesRepeat: [ stream next ]. 169 | stream upToEnd.]. 170 | 171 | 5. Line Ending Conventions 172 | If you want to write files following a specific line ending convention, use the ZnNewLineWriterStream. 173 | This stream decorator will transform any line ending (cr, lf, crlf) into a defined line ending. 174 | By default, it chooses the platform line ending convention. 175 | lineWriter := ZnNewLineWriterStream on: aStream. 176 | If you want to choose another line ending convention you can do: 177 | lineWriter forCr. 178 | lineWriter forLf. 179 | lineWriter forCrLf. 180 | lineWriter forPlatformLineEnding. 181 | ------------------------------------------- 182 | Old comment: 183 | 184 | I represent a Stream that accesses a FilePage from a File. One use for my instance is to access larger ""virtual Strings"" than can be stored contiguously in main memory. I restrict the objects stored and retrieved to be Integers or Characters. An end of file pointer terminates reading; it can be extended by writing past it, or the file can be explicitly truncated. 185 | 186 | To use the file system for most applications, you typically create a FileStream. This is done by sending a message to a FileDirectory (file:, oldFile:, newFile:, rename:newName:) which creates an instance of me. Accesses to the file are then done via my instance. 187 | 188 | *** On DOS, files cannot be shortened! *** To overwrite a file with a shorter one, first delete the old file (FileDirectory deleteFilePath: 'Hard Disk:aFolder:dataFolder:foo') or (aFileDirectory deleteFileNamed: 'foo'). Then write your new shorter version. 189 | " 190 | Class { 191 | #name : 'OldFileStream', 192 | #superclass : 'ReadWriteStream', 193 | #classVars : [ 194 | 'Stderr', 195 | 'Stdin', 196 | 'StdioFiles', 197 | 'Stdout', 198 | 'TheStdioHandles' 199 | ], 200 | #category : 'OldFileStream-Base', 201 | #package : 'OldFileStream', 202 | #tag : 'Base' 203 | } 204 | 205 | { #category : 'file reader services' } 206 | OldFileStream class >> changesFileSuffixes [ 207 | 208 | ^#('changes') 209 | 210 | 211 | ] 212 | 213 | { #category : 'concrete classes' } 214 | OldFileStream class >> concreteStream [ 215 | "Who should we really direct class queries to? " 216 | ^ OldMultiByteFileStream. 217 | 218 | ] 219 | 220 | { #category : 'utilities' } 221 | OldFileStream class >> convertCRtoLF: fileName [ 222 | "Convert the given file to LF line endings. Put the result in a file with the extention '.lf'" 223 | 224 | | in out c justPutCR | 225 | in := (self readOnlyFileNamed: fileName) binary. 226 | out := (self newFileNamed: fileName, '.lf') binary. 227 | justPutCR := false. 228 | [in atEnd] whileFalse: [ 229 | c := in next. 230 | c = 10 231 | ifTrue: [ 232 | out nextPut: 13. 233 | justPutCR := true] 234 | ifFalse: [ 235 | (justPutCR and: [c = 10]) ifFalse: [out nextPut: c]. 236 | justPutCR := false]]. 237 | in close. 238 | out close. 239 | 240 | ] 241 | 242 | { #category : 'instance creation' } 243 | OldFileStream class >> detectFile: aBlock do: anotherBlock [ 244 | 245 | ^aBlock value 246 | ifNil: [nil] 247 | ifNotNil: [:file| [anotherBlock value: file] ensure: [file close]] 248 | ] 249 | 250 | { #category : 'file reader services' } 251 | OldFileStream class >> fileIn: fullName [ 252 | "File in the entire contents of the file specified by the name provided" 253 | 254 | | ff fn | 255 | fullName ifNil: [^ self inform: 'Filename is nil.']. 256 | fn := fullName asFileReference. 257 | fn := (Smalltalk hasClassNamed: #GZipReadStream) 258 | ifTrue: [(Smalltalk classNamed: #GZipReadStream) uncompressedFileName: fn fullName] 259 | ifFalse: [fn fullName]. 260 | ff := self readOnlyFileNamed: fn. 261 | ff fileIn. 262 | 263 | ] 264 | 265 | { #category : 'instance creation' } 266 | OldFileStream class >> fileNamed: fileName [ 267 | ^ self concreteStream fileNamed: (self fullName: fileName) 268 | ] 269 | 270 | { #category : 'instance creation' } 271 | OldFileStream class >> fileNamed: fileName do: aBlock [ 272 | "Returns the result of aBlock." 273 | 274 | ^ self detectFile: [ self fileNamed: fileName ] do: aBlock 275 | ] 276 | 277 | { #category : 'stdio' } 278 | OldFileStream class >> flushAndVoidStdioFiles [ 279 | 280 | StdioFiles ifNotNil: [ 281 | StdioFiles do: [ :file | 282 | file ifNotNil: [ 283 | file isReadOnly ifFalse: [ 284 | [ file flush ] 285 | on: Error 286 | do: [ :ex | "care less" ] ] ] ]. 287 | ]. 288 | 289 | self voidStdioFiles 290 | ] 291 | 292 | { #category : 'instance creation' } 293 | OldFileStream class >> forceNewFileNamed: fileName [ 294 | "Create a new file with the given name, and answer a stream opened for writing on that file. If the file already exists, delete it without asking before creating the new file." 295 | 296 | SessionManager default currentSession isReadOnlyAccessMode ifTrue: [ ((CannotDeleteFileException fileName: fileName) 297 | messageText: 'Could not delete the old version of file ' , fileName) signal. 298 | ^ NullStream new ]. 299 | 300 | ^self concreteStream forceNewFileNamed: fileName 301 | ] 302 | 303 | { #category : 'instance creation' } 304 | OldFileStream class >> forceNewFileNamed: fileName do: aBlock [ 305 | "Returns the result of aBlock." 306 | 307 | ^ self detectFile: [ self forceNewFileNamed: fileName ] do: aBlock 308 | ] 309 | 310 | { #category : 'instance creation' } 311 | OldFileStream class >> fullName: fileName [ 312 | ^ fileName asFileReference fullName 313 | ] 314 | 315 | { #category : 'initialize-release' } 316 | OldFileStream class >> initialize [ 317 | TheStdioHandles := Array new: 3. 318 | SessionManager default registerSystemClassNamed: self name 319 | ] 320 | 321 | { #category : 'instance creation' } 322 | OldFileStream class >> isAFileNamed: fName [ 323 | "return whether a file exists with the given name" 324 | ^self concreteStream isAFileNamed: (self fullName: fName) 325 | ] 326 | 327 | { #category : 'file reader services' } 328 | OldFileStream class >> isChangesFileSuffix: suffix [ 329 | 330 | ^ self changesFileSuffixes includes: suffix 331 | 332 | ] 333 | 334 | { #category : 'deprecation' } 335 | OldFileStream class >> isDeprecated [ 336 | ^true 337 | ] 338 | 339 | { #category : 'file reader services' } 340 | OldFileStream class >> isSourceFileSuffix: suffix [ 341 | 342 | ^ self sourceFileSuffixes includes: suffix 343 | 344 | ] 345 | 346 | { #category : 'instance creation' } 347 | OldFileStream class >> new [ 348 | ^ self basicNew 349 | ] 350 | 351 | { #category : 'instance creation' } 352 | OldFileStream class >> newFileNamed: fileName [ 353 | ^ self concreteStream newFileNamed: (self fullName: fileName) 354 | ] 355 | 356 | { #category : 'instance creation' } 357 | OldFileStream class >> newFileNamed: fileName do: aBlock [ 358 | "Returns the result of aBlock." 359 | 360 | ^ self detectFile: [ self newFileNamed: fileName ] do: aBlock 361 | ] 362 | 363 | { #category : 'stdio' } 364 | OldFileStream class >> newForStdio [ 365 | "This is a hook for subclasses to initialize themselves properly." 366 | 367 | ^self new 368 | ] 369 | 370 | { #category : 'instance creation' } 371 | OldFileStream class >> oldFileNamed: fileName [ 372 | ^ self concreteStream oldFileNamed: (self fullName: fileName) 373 | ] 374 | 375 | { #category : 'instance creation' } 376 | OldFileStream class >> oldFileNamed: fileName do: aBlock [ 377 | "Returns the result of aBlock." 378 | 379 | ^ self detectFile: [ self oldFileNamed: fileName ] do: aBlock 380 | ] 381 | 382 | { #category : 'instance creation' } 383 | OldFileStream class >> oldFileOrNoneNamed: fileName [ 384 | "If the file exists, answer a read-only FileStream on it. If it doesn't, answer nil." 385 | 386 | | fullName | 387 | fullName := self fullName: fileName. 388 | ^ (self concreteStream isAFileNamed: fullName) 389 | ifTrue: [ self concreteStream readOnlyFileNamed: fullName] 390 | ifFalse: [ nil]. 391 | 392 | ] 393 | 394 | { #category : 'instance creation' } 395 | OldFileStream class >> onHandle: aFileSystemHandle [ 396 | ^ self concreteStream new 397 | open: aFileSystemHandle fullName 398 | forWrite: aFileSystemHandle isWritable 399 | ] 400 | 401 | { #category : 'instance creation' } 402 | OldFileStream class >> readOnlyFileNamed: fileName [ 403 | ^ self concreteStream readOnlyFileNamed: (self fullName: fileName) 404 | ] 405 | 406 | { #category : 'instance creation' } 407 | OldFileStream class >> readOnlyFileNamed: fileName do: aBlock [ 408 | "Open the existing file with the given name for read-only access and pass it as argument to aBlock. 409 | Returns the result of aBlock." 410 | 411 | ^ self detectFile: [ self readOnlyFileNamed: fileName ] do: aBlock 412 | ] 413 | 414 | { #category : 'file reader services' } 415 | OldFileStream class >> removeLineFeeds: fullName [ 416 | | fileContents | 417 | fileContents := ((OldFileStream readOnlyFileNamed: fullName) wantsLineEndConversion: true) contentsOfEntireFile. 418 | (OldFileStream newFileNamed: fullName) 419 | nextPutAll: fileContents; 420 | close. 421 | ] 422 | 423 | { #category : 'dnd requests' } 424 | OldFileStream class >> requestDropStream: dropIndex [ 425 | "Request a read-only stream for some file that was dropped onto the application" 426 | ^self concreteStream new requestDropStream: dropIndex. 427 | ] 428 | 429 | { #category : 'system startup' } 430 | OldFileStream class >> shutDown: isImageQuitting [ 431 | isImageQuitting ifTrue: [ self flushAndVoidStdioFiles ] 432 | ] 433 | 434 | { #category : 'file reader services' } 435 | OldFileStream class >> sourceFileSuffixes [ 436 | 437 | ^#('st' 'cs') 438 | 439 | 440 | ] 441 | 442 | { #category : 'stdio' } 443 | OldFileStream class >> standardIOStreamNamed: moniker forWrite: forWrite [ 444 | "Create if necessary and store default stdin, stdout and other files based on the their names" 445 | 446 | | index | 447 | 448 | "This is an ugly hack, while waiting for a real fix for windows. There several problems with this approach, but it allow us to run tests, etc." 449 | Smalltalk os isWin32 450 | ifTrue: [ 451 | [ ^ OldMultiByteFileStream forceNewFileNamed: moniker asString ] 452 | on: CannotDeleteFileException do: [ 453 | "HACK: if the image is opened a second time windows barks about the already opened locked file" 454 | ^ OldMultiByteFileStream forceNewFileNamed: moniker asString, '_', (Random new nextInt: SmallInteger maxVal) asString ]]. 455 | 456 | index := #(stdin stdout stderr) identityIndexOf: moniker. 457 | ^((StdioFiles ifNil: [ StdioFiles := Array new: 3 ]) at: index) 458 | ifNil: [ 459 | StdioFiles 460 | at: index 461 | put: ( 462 | (TheStdioHandles at: index) 463 | ifNil: [ ^self error: moniker, ' is unavailable' ] 464 | ifNotNil: [ :handle | 465 | OldMultiByteFileStream newForStdio 466 | openOnHandle: handle 467 | name: moniker 468 | forWrite: forWrite ]) ] 469 | 470 | ] 471 | 472 | { #category : 'system startup' } 473 | OldFileStream class >> startUp: isImageStarting [ 474 | isImageStarting 475 | ifFalse: [ ^ self ]. 476 | self voidStdioFiles. 477 | [ TheStdioHandles := self stdioHandles ] 478 | on: Error 479 | do: [ :ex | 480 | TheStdioHandles isArray 481 | ifFalse: [ TheStdioHandles := Array new: 3 ] ] 482 | ] 483 | 484 | { #category : 'stdio' } 485 | OldFileStream class >> stderr [ 486 | 487 | ^Stderr ifNil: [ Stderr := self standardIOStreamNamed: #stderr forWrite: true ] 488 | ] 489 | 490 | { #category : 'stdio' } 491 | OldFileStream class >> stdin [ 492 | 493 | ^Stdin ifNil: [ 494 | Stdin := self standardIOStreamNamed: #stdin forWrite: false. 495 | Stdin 496 | disableReadBuffering; 497 | yourself ]. 498 | ] 499 | 500 | { #category : 'stdio' } 501 | OldFileStream class >> stdioHandles [ 502 | 503 | self primitiveFailed 504 | ] 505 | 506 | { #category : 'stdio' } 507 | OldFileStream class >> stdout [ 508 | 509 | ^Stdout ifNil: [ Stdout := self standardIOStreamNamed: #stdout forWrite: true ] 510 | ] 511 | 512 | { #category : 'stdio' } 513 | OldFileStream class >> voidStdioFiles [ 514 | 515 | Smalltalk os isWin32 ifTrue: [ 516 | {Stdout . Stderr } do: [ :each | 517 | [ each ifNotNil: [ 518 | each size isZero ifTrue: [ 519 | each close. 520 | each name asFileReference delete 521 | ] 522 | ] 523 | ] ifError: [ ]. 524 | ] 525 | ]. 526 | 527 | Stdin := Stdout := Stderr := StdioFiles := nil 528 | ] 529 | 530 | { #category : 'utilities' } 531 | OldFileStream class >> writeSourceCodeFrom: aStream baseName: baseName isSt: stOrCsFlag [ 532 | 533 | | extension converter fileName | 534 | [ extension := stOrCsFlag ifTrue: ['.st'] ifFalse: ['.cs']. 535 | converter := aStream contents isAsciiString 536 | ifTrue: [MacRomanTextConverter new] 537 | ifFalse: [UTF8TextConverter new]. 538 | fileName := baseName, extension. 539 | fileName := FileSystem disk checkName: fileName fixErrors: true. 540 | [OldFileStream newFileNamed: fileName do: [:fileStream | 541 | fileName := fileStream name. "in case it is changed when handling FileExistsException" 542 | (converter isMemberOf: UTF8TextConverter) 543 | ifTrue: [fileStream binary. 544 | UTF8TextConverter writeBOMOn: fileStream]. 545 | fileStream 546 | text; 547 | converter: converter; 548 | nextPutAll: aStream contents; 549 | close]] on: Abort do: [:e | ^self ] 550 | ] on: Error do: 551 | [ :error | 552 | error isResumable 553 | ifTrue: [ error resumeUnchecked: error defaultAction] 554 | ifFalse: [ error pass ] 555 | ]. 556 | self inform: 'Filed out to: ', String cr, fileName. 557 | ] 558 | 559 | { #category : 'converting' } 560 | OldFileStream >> asBinaryOrTextStream [ 561 | "I can switch between binary and text data" 562 | 563 | ^ self 564 | ] 565 | 566 | { #category : 'modes' } 567 | OldFileStream >> ascii [ 568 | "Set this file to ascii (text) mode." 569 | 570 | self subclassResponsibility 571 | 572 | ] 573 | 574 | { #category : 'testing' } 575 | OldFileStream >> atEnd [ 576 | "Answer true if the current position is >= the end of file position." 577 | 578 | self subclassResponsibility 579 | ] 580 | 581 | { #category : 'modes' } 582 | OldFileStream >> binary [ 583 | "Set this file to binary mode." 584 | 585 | self subclassResponsibility 586 | 587 | ] 588 | 589 | { #category : 'open/close' } 590 | OldFileStream >> close [ 591 | "Close this file." 592 | 593 | self subclassResponsibility 594 | 595 | ] 596 | 597 | { #category : 'testing' } 598 | OldFileStream >> closed [ 599 | "Answer true if this file is closed." 600 | 601 | self subclassResponsibility 602 | 603 | ] 604 | 605 | { #category : 'accessing' } 606 | OldFileStream >> contents [ 607 | "Return the contents of the receiver. Do not close or otherwise touch the receiver. Return data in whatever mode the receiver is in (e.g., binary or text)." 608 | | s savePos | 609 | savePos := self position. 610 | self position: 0. 611 | s := self next: self size. 612 | self position: savePos. 613 | ^s 614 | ] 615 | 616 | { #category : 'accessing' } 617 | OldFileStream >> contentsOfEntireFile [ 618 | "Read all of the contents of the receiver." 619 | 620 | | s binary | 621 | self readOnly. 622 | binary := self isBinary. 623 | self reset. "erases knowledge of whether it is binary" 624 | binary ifTrue: [self binary]. 625 | s := self next: self size. 626 | self close. 627 | ^s 628 | ] 629 | 630 | { #category : 'actions' } 631 | OldFileStream >> delete [ 632 | 633 | (File named: self name) delete 634 | ] 635 | 636 | { #category : 'actions' } 637 | OldFileStream >> exists [ 638 | 639 | ^ (File named: self name) exists 640 | ] 641 | 642 | { #category : 'accessing' } 643 | OldFileStream >> file [ 644 | "Answer the file for the page the receiver is streaming over." 645 | 646 | self subclassResponsibility 647 | ] 648 | 649 | { #category : 'ToDeprecate' } 650 | OldFileStream >> fileIn [ 651 | "Guarantee that the receiver is readOnly before fileIn for efficiency and 652 | to eliminate remote sharing conflicts." 653 | 654 | self readOnly. 655 | CodeImporter evaluateFileStream: self. 656 | ] 657 | 658 | { #category : 'flushing' } 659 | OldFileStream >> flush [ 660 | "When writing, this flushes the write buffer the stream uses to reduce 661 | the number of write() system calls it makes. This should generally be 662 | used before #sync, but on Windows they do the same thing." 663 | 664 | self subclassResponsibility 665 | 666 | ] 667 | 668 | { #category : 'accessing' } 669 | OldFileStream >> localName [ 670 | 671 | ^ self name asFileReference basename 672 | 673 | ] 674 | 675 | { #category : 'printing' } 676 | OldFileStream >> longPrintOn: aStream [ 677 | "Do nothing, so it will print short. Called to print the error file. If the error was in a file operation, we can't read the contents of that file. Just print its name instead." 678 | 679 | ] 680 | 681 | { #category : 'printing' } 682 | OldFileStream >> longPrintOn: aStream limitedTo: sizeLimit indent: indent [ 683 | 684 | "Do nothing, so it will print short. Called to print the error file. If the error was in a file operation, we can't read the contents of that file. Just print its name instead." 685 | 686 | aStream cr 687 | ] 688 | 689 | { #category : 'accessing' } 690 | OldFileStream >> mimeTypes [ 691 | ^ self name asFileReference mimeTypes. 692 | ] 693 | 694 | { #category : 'accessing' } 695 | OldFileStream >> name [ 696 | "Answer the name of the file for the page the receiver is streaming over." 697 | 698 | self subclassResponsibility 699 | ] 700 | 701 | { #category : 'accessing' } 702 | OldFileStream >> next [ 703 | 704 | (position >= readLimit and: [self atEnd]) 705 | ifTrue: [^nil] 706 | ifFalse: [^collection at: (position := position + 1)] 707 | ] 708 | 709 | { #category : 'accessing' } 710 | OldFileStream >> next: anInteger [ 711 | 712 | | newCollection howManyRead increment | 713 | newCollection := self collectionSpecies new: anInteger. 714 | howManyRead := 0. 715 | [howManyRead < anInteger] whileTrue: 716 | [self atEnd ifTrue: 717 | [(howManyRead + 1) to: anInteger do: [:i | newCollection at: i put: (self next)]. 718 | ^newCollection]. 719 | increment := (readLimit - position) min: (anInteger - howManyRead). 720 | newCollection replaceFrom: (howManyRead + 1) 721 | to: (howManyRead := howManyRead + increment) 722 | with: collection 723 | startingAt: (position + 1). 724 | position := position + increment]. 725 | ^newCollection 726 | ] 727 | 728 | { #category : 'accessing' } 729 | OldFileStream >> nextPut: aByte [ 730 | "1/31/96 sw: subclassResponsibility" 731 | 732 | self subclassResponsibility 733 | ] 734 | 735 | { #category : 'accessing' } 736 | OldFileStream >> nextPutAll: aCollection [ 737 | "1/31/96 sw: made subclass responsibility" 738 | 739 | self subclassResponsibility 740 | ] 741 | 742 | { #category : 'positioning' } 743 | OldFileStream >> position [ 744 | "Answer the current character position in the file." 745 | 746 | self subclassResponsibility 747 | ] 748 | 749 | { #category : 'positioning' } 750 | OldFileStream >> position: pos [ 751 | "Set the current character position in the file to pos." 752 | 753 | self subclassResponsibility 754 | ] 755 | 756 | { #category : 'printing' } 757 | OldFileStream >> printOn: aStream [ 758 | 759 | super printOn: aStream. 760 | aStream nextPutAll: ' on '. 761 | self file printOn: aStream 762 | ] 763 | 764 | { #category : 'modes' } 765 | OldFileStream >> readOnly [ 766 | "Set this file's mode to read-only." 767 | 768 | self subclassResponsibility 769 | 770 | ] 771 | 772 | { #category : 'modes' } 773 | OldFileStream >> readOnlyStream [ 774 | ^self readOnly 775 | ] 776 | 777 | { #category : 'modes' } 778 | OldFileStream >> readWrite [ 779 | "Set this file's mode to read-write." 780 | 781 | self subclassResponsibility 782 | 783 | ] 784 | 785 | { #category : 'open/close' } 786 | OldFileStream >> reopen [ 787 | "Ensure that the receiver is open, re-open it if necessary." 788 | "Details: Files that were open when a snapshot occurs are no longer valid when the snapshot is resumed. This operation re-opens the file if that has happened." 789 | 790 | self subclassResponsibility 791 | 792 | ] 793 | 794 | { #category : 'initialization' } 795 | OldFileStream >> reset [ 796 | "Set the current character position to the beginning of the file." 797 | 798 | self subclassResponsibility 799 | ] 800 | 801 | { #category : 'positioning' } 802 | OldFileStream >> setToEnd [ 803 | "Set the current character position to the end of the File. The same as 804 | self position: self size." 805 | 806 | self subclassResponsibility 807 | ] 808 | 809 | { #category : 'accessing' } 810 | OldFileStream >> size [ 811 | "Answer the size of the file in characters." 812 | 813 | self subclassResponsibility 814 | ] 815 | 816 | { #category : 'positioning' } 817 | OldFileStream >> skip: n [ 818 | "Set the character position to n characters from the current position. 819 | Error if not enough characters left in the file." 820 | 821 | self subclassResponsibility 822 | ] 823 | 824 | { #category : 'flushing' } 825 | OldFileStream >> sync [ 826 | "When writing, this syncs any written/flushed data still in the kernel 827 | file system buffers to disk. This should generally be used after #flush, 828 | but on Windows they do the same thing." 829 | 830 | self subclassResponsibility 831 | 832 | ] 833 | 834 | { #category : 'modes' } 835 | OldFileStream >> text [ 836 | "Set this file to text (ascii) mode." 837 | 838 | self ascii. 839 | 840 | ] 841 | 842 | { #category : 'positioning' } 843 | OldFileStream >> truncate: pos [ 844 | "Truncate file to pos" 845 | 846 | self subclassResponsibility 847 | ] 848 | -------------------------------------------------------------------------------- /repository/OldFileStream/OldLimitingLineStreamWrapper.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I'm a wrapper for a stream optimized for line-by-line access using #nextLine. My instances can be nested. 3 | 4 | I read one line ahead. Reading terminates when the stream ends, or if the limitingBlock evaluated with the line answers true. To skip the delimiting line for further reading use #skipThisLine. 5 | 6 | Character-based reading (#next) is permitted, too. Send #updatePosition when switching from line-based reading. 7 | 8 | See examples at the class side. 9 | 10 | --bf 2/19/1999 12:52 11 | " 12 | Class { 13 | #name : 'OldLimitingLineStreamWrapper', 14 | #superclass : 'Object', 15 | #instVars : [ 16 | 'stream', 17 | 'line', 18 | 'limitingBlock', 19 | 'position' 20 | ], 21 | #category : 'OldFileStream-Base', 22 | #package : 'OldFileStream', 23 | #tag : 'Base' 24 | } 25 | 26 | { #category : 'examples' } 27 | OldLimitingLineStreamWrapper class >> example1 [ 28 | 29 | "LimitingLineStreamWrapper example1" 30 | "Separate chunks of text delimited by a special string" 31 | | inStream msgStream messages | 32 | inStream := self exampleStream. 33 | msgStream := self on: inStream delimiter: 'From '. 34 | messages := OrderedCollection new. 35 | [inStream atEnd] whileFalse: [ 36 | msgStream skipThisLine. 37 | messages add: msgStream upToEnd]. 38 | ^messages 39 | 40 | ] 41 | 42 | { #category : 'examples' } 43 | OldLimitingLineStreamWrapper class >> example2 [ 44 | 45 | "LimitingLineStreamWrapper example2" 46 | "Demo nesting wrappers - get header lines from some messages" 47 | | inStream msgStream headers headerStream | 48 | inStream := self exampleStream. 49 | msgStream := self on: inStream delimiter: 'From '. 50 | headers := OrderedCollection new. 51 | [inStream atEnd] whileFalse: [ 52 | msgStream skipThisLine. "Skip From" 53 | headerStream := self on: msgStream delimiter: ''. 54 | headers add: headerStream linesUpToEnd. 55 | [msgStream nextLine isNil] whileFalse. "Skip Body" 56 | ]. 57 | ^headers 58 | 59 | ] 60 | 61 | { #category : 'examples' } 62 | OldLimitingLineStreamWrapper class >> exampleStream [ 63 | 64 | ^ 'From me@somewhere 65 | From: me 66 | To: you 67 | Subject: Test 68 | 69 | Test 70 | 71 | From you@elsewhere 72 | From: you 73 | To: me 74 | Subject: Re: test 75 | 76 | okay 77 | ' readStream 78 | ] 79 | 80 | { #category : 'deprecation' } 81 | OldLimitingLineStreamWrapper class >> isDeprecated [ 82 | ^true 83 | ] 84 | 85 | { #category : 'instance creation' } 86 | OldLimitingLineStreamWrapper class >> on: aStream delimiter: aString [ 87 | 88 | ^self new setStream: aStream delimiter: aString 89 | 90 | ] 91 | 92 | { #category : 'testing' } 93 | OldLimitingLineStreamWrapper >> atEnd [ 94 | 95 | ^line isNil or: [limitingBlock value: line] 96 | ] 97 | 98 | { #category : 'stream protocol' } 99 | OldLimitingLineStreamWrapper >> close [ 100 | ^stream close 101 | ] 102 | 103 | { #category : 'accessing' } 104 | OldLimitingLineStreamWrapper >> delimiter: aString [ 105 | "Set limitBlock to check for a delimiting string. Be unlimiting if nil" 106 | 107 | self limitingBlock: (aString caseOf: { 108 | [nil] -> [[:aLine | false]]. 109 | [''] -> [[:aLine | aLine size = 0]] 110 | } otherwise: [[:aLine | aLine beginsWith: aString]]) 111 | 112 | ] 113 | 114 | { #category : 'accessing' } 115 | OldLimitingLineStreamWrapper >> lastLineRead [ 116 | "Return line last read. At stream end, this is the boundary line or nil" 117 | 118 | ^ line 119 | ] 120 | 121 | { #category : 'accessing' } 122 | OldLimitingLineStreamWrapper >> limitingBlock: aBlock [ 123 | "The limitingBlock is evaluated with a line to check if this line terminates the stream" 124 | 125 | limitingBlock := aBlock. 126 | self updatePosition 127 | ] 128 | 129 | { #category : 'accessing' } 130 | OldLimitingLineStreamWrapper >> linesUpToEnd [ 131 | 132 | | elements ln | 133 | elements := OrderedCollection new. 134 | [(ln := self nextLine) isNil] whileFalse: [ 135 | elements add: ln]. 136 | ^elements 137 | ] 138 | 139 | { #category : 'accessing' } 140 | OldLimitingLineStreamWrapper >> next [ 141 | "Provide character-based access" 142 | 143 | position ifNil: [^nil]. 144 | position < line size ifTrue: [^line at: (position := position + 1)]. 145 | line := stream nextLine. 146 | self updatePosition. 147 | ^ Character cr 148 | ] 149 | 150 | { #category : 'accessing' } 151 | OldLimitingLineStreamWrapper >> nextLine [ 152 | 153 | | thisLine | 154 | self atEnd ifTrue: [^nil]. 155 | thisLine := line. 156 | line := stream nextLine. 157 | ^thisLine 158 | 159 | ] 160 | 161 | { #category : 'accessing' } 162 | OldLimitingLineStreamWrapper >> peekLine [ 163 | 164 | self atEnd ifTrue: [^nil]. 165 | ^ line 166 | ] 167 | 168 | { #category : 'printing' } 169 | OldLimitingLineStreamWrapper >> printOn: aStream [ 170 | 171 | super printOn: aStream. 172 | aStream nextPutAll: ' on '. 173 | stream printOn: aStream 174 | ] 175 | 176 | { #category : 'private' } 177 | OldLimitingLineStreamWrapper >> setStream: aStream delimiter: aString [ 178 | 179 | stream := aStream. 180 | line := stream nextLine. 181 | self delimiter: aString. "sets position" 182 | 183 | ] 184 | 185 | { #category : 'accessing' } 186 | OldLimitingLineStreamWrapper >> skipThisLine [ 187 | 188 | line := stream nextLine. 189 | self updatePosition. 190 | 191 | ] 192 | 193 | { #category : 'accessing' } 194 | OldLimitingLineStreamWrapper >> upToEnd [ 195 | 196 | 197 | ^String streamContents: [:strm | | ln | 198 | [(ln := self nextLine) isNil] whileFalse: [ 199 | strm nextPutAll: ln; cr]] 200 | ] 201 | 202 | { #category : 'accessing' } 203 | OldLimitingLineStreamWrapper >> updatePosition [ 204 | "Call this before doing character-based access" 205 | 206 | position := self atEnd ifFalse: [0] 207 | ] 208 | -------------------------------------------------------------------------------- /repository/OldFileStream/OldMultiByteBinaryOrTextStream.class.st: -------------------------------------------------------------------------------- 1 | " 2 | It is similar to MultiByteFileStream, but works on in memory stream. 3 | " 4 | Class { 5 | #name : 'OldMultiByteBinaryOrTextStream', 6 | #superclass : 'ReadWriteStream', 7 | #instVars : [ 8 | 'isBinary', 9 | 'converter' 10 | ], 11 | #category : 'OldFileStream-Base', 12 | #package : 'OldFileStream', 13 | #tag : 'Base' 14 | } 15 | 16 | { #category : 'defaults' } 17 | OldMultiByteBinaryOrTextStream class >> defaultConverter [ 18 | ^ Latin1TextConverter new. 19 | 20 | ] 21 | 22 | { #category : 'deprecation' } 23 | OldMultiByteBinaryOrTextStream class >> isDeprecated [ 24 | ^true 25 | ] 26 | 27 | { #category : 'instance creation' } 28 | OldMultiByteBinaryOrTextStream class >> on: aCollection encoding: encodingName [ 29 | | aTextConverter | 30 | encodingName 31 | ifNil: [aTextConverter := TextConverter default] 32 | ifNotNil: [aTextConverter := TextConverter newForEncoding: encodingName]. 33 | ^ (self on: aCollection) 34 | converter: aTextConverter 35 | ] 36 | 37 | { #category : 'instance creation' } 38 | OldMultiByteBinaryOrTextStream class >> with: aCollection encoding: encodingName [ 39 | | aTextConverter | 40 | encodingName 41 | ifNil: [aTextConverter := TextConverter default] 42 | ifNotNil: [aTextConverter := TextConverter newForEncoding: encodingName]. 43 | ^ (self with: aCollection) 44 | converter: aTextConverter 45 | ] 46 | 47 | { #category : 'converting' } 48 | OldMultiByteBinaryOrTextStream >> asBinaryOrTextStream [ 49 | 50 | ^ self 51 | 52 | ] 53 | 54 | { #category : 'modes' } 55 | OldMultiByteBinaryOrTextStream >> ascii [ 56 | isBinary := false 57 | 58 | ] 59 | 60 | { #category : 'private' } 61 | OldMultiByteBinaryOrTextStream >> basicNext [ 62 | | nextChar | 63 | 64 | ^ isBinary 65 | ifTrue: [super next] 66 | ifFalse: [ 67 | (nextChar := super next) 68 | ifNotNil: [nextChar asCharacter]]. 69 | ] 70 | 71 | { #category : 'private' } 72 | OldMultiByteBinaryOrTextStream >> basicNext: anInteger [ 73 | 74 | ^ super next: anInteger. 75 | 76 | ] 77 | 78 | { #category : 'private' } 79 | OldMultiByteBinaryOrTextStream >> basicNext: n into: aString [ 80 | 81 | ^ self next: n into: aString. 82 | 83 | ] 84 | 85 | { #category : 'private' } 86 | OldMultiByteBinaryOrTextStream >> basicNext: anInteger putAll: aCollection startingAt: startIndex [ 87 | 88 | ^super next: anInteger putAll: aCollection startingAt: startIndex 89 | ] 90 | 91 | { #category : 'private' } 92 | OldMultiByteBinaryOrTextStream >> basicNextInto: aString [ 93 | 94 | ^ self nextInto: aString. 95 | 96 | ] 97 | 98 | { #category : 'private' } 99 | OldMultiByteBinaryOrTextStream >> basicNextPut: char [ 100 | 101 | ^ super nextPut: char. 102 | 103 | ] 104 | 105 | { #category : 'private' } 106 | OldMultiByteBinaryOrTextStream >> basicNextPutAll: aString [ 107 | 108 | ^ super nextPutAll: aString. 109 | 110 | ] 111 | 112 | { #category : 'private' } 113 | OldMultiByteBinaryOrTextStream >> basicPeek [ 114 | 115 | ^ super peek 116 | 117 | ] 118 | 119 | { #category : 'private' } 120 | OldMultiByteBinaryOrTextStream >> basicPosition [ 121 | 122 | ^ self position. 123 | 124 | ] 125 | 126 | { #category : 'private' } 127 | OldMultiByteBinaryOrTextStream >> basicPosition: pos [ 128 | 129 | ^ self position: pos. 130 | 131 | ] 132 | 133 | { #category : 'modes' } 134 | OldMultiByteBinaryOrTextStream >> binary [ 135 | isBinary := true 136 | 137 | ] 138 | 139 | { #category : 'accessing' } 140 | OldMultiByteBinaryOrTextStream >> contents [ 141 | 142 | | ret state | 143 | state := converter saveStateOf: self. 144 | ret := self upToEnd. 145 | converter restoreStateOf: self with: state. 146 | ^ ret. 147 | 148 | ] 149 | 150 | { #category : 'accessing' } 151 | OldMultiByteBinaryOrTextStream >> converter [ 152 | 153 | converter ifNil: [converter := self class defaultConverter]. 154 | ^ converter 155 | 156 | ] 157 | 158 | { #category : 'accessing' } 159 | OldMultiByteBinaryOrTextStream >> converter: aConverter [ 160 | 161 | converter := aConverter. 162 | 163 | ] 164 | 165 | { #category : 'testing' } 166 | OldMultiByteBinaryOrTextStream >> isBinary [ 167 | ^ isBinary 168 | ] 169 | 170 | { #category : 'accessing' } 171 | OldMultiByteBinaryOrTextStream >> next [ 172 | 173 | | n | 174 | n := self converter nextFromStream: self. 175 | n ifNil: [^ nil]. 176 | isBinary and: [n isCharacter ifTrue: [^ n asciiValue]]. 177 | ^ n. 178 | 179 | ] 180 | 181 | { #category : 'accessing' } 182 | OldMultiByteBinaryOrTextStream >> next: anInteger [ 183 | 184 | | multiString | 185 | self isBinary ifTrue: [^ (super next: anInteger) asByteArray]. 186 | multiString := WideString new: anInteger. 187 | 1 to: anInteger do: [:index | 188 | | character | 189 | (character := self next) ifNotNil: [ 190 | multiString at: index put: character 191 | ] ifNil: [ 192 | multiString := multiString copyFrom: 1 to: index - 1. 193 | ^ multiString 194 | ] 195 | ]. 196 | ^ multiString. 197 | 198 | ] 199 | 200 | { #category : 'accessing' } 201 | OldMultiByteBinaryOrTextStream >> next: anInteger putAll: aCollection startingAt: startIndex [ 202 | 203 | 204 | (self isBinary or: [ aCollection class == ByteArray ]) ifTrue: [ 205 | ^super next: anInteger putAll: aCollection startingAt: startIndex ]. 206 | ^self converter next: anInteger putAll: aCollection startingAt: startIndex toStream: self 207 | ] 208 | 209 | { #category : 'accessing' } 210 | OldMultiByteBinaryOrTextStream >> nextDelimited: terminator [ 211 | 212 | | out ch pos | 213 | out := (String new: 1000) writeStream. 214 | self atEnd ifTrue: [^ '']. 215 | pos := self position. 216 | self next = terminator ifFalse: [ 217 | "absorb initial terminator" 218 | self position: pos. 219 | ]. 220 | [(ch := self next) == nil] whileFalse: [ 221 | (ch = terminator) ifTrue: [ 222 | self peek = terminator ifTrue: [ 223 | self next. "skip doubled terminator" 224 | ] ifFalse: [ 225 | ^ out contents "terminator is not doubled; we're done!" 226 | ]. 227 | ]. 228 | out nextPut: ch. 229 | ]. 230 | ^ out contents. 231 | 232 | ] 233 | 234 | { #category : 'accessing' } 235 | OldMultiByteBinaryOrTextStream >> nextMatchAll: aColl [ 236 | 237 | | save | 238 | save := converter saveStateOf: self. 239 | aColl do: [:each | 240 | (self next) = each ifFalse: [ 241 | converter restoreStateOf: self with: save. 242 | ^ false. 243 | ]. 244 | ]. 245 | ^ true. 246 | 247 | ] 248 | 249 | { #category : 'accessing' } 250 | OldMultiByteBinaryOrTextStream >> nextPut: aCharacter [ 251 | ^ aCharacter isInteger 252 | ifTrue: [ super nextPut: aCharacter asCharacter ] 253 | ifFalse: [ self converter nextPut: aCharacter toStream: self ] 254 | ] 255 | 256 | { #category : 'accessing' } 257 | OldMultiByteBinaryOrTextStream >> nextPutAll: aCollection [ 258 | ^ self isBinary 259 | ifTrue: [ super nextPutAll: aCollection ] 260 | ifFalse: [ aCollection do: [ :each | self nextPut: each ] ] 261 | ] 262 | 263 | { #category : 'accessing' } 264 | OldMultiByteBinaryOrTextStream >> padToEndWith: aChar [ 265 | "We don't have pages, so we are at the end, and don't need to pad." 266 | ] 267 | 268 | { #category : 'accessing' } 269 | OldMultiByteBinaryOrTextStream >> peek [ 270 | "Answer what would be returned if the message next were sent to the receiver. If the receiver is at the end, answer nil. " 271 | 272 | | next pos | 273 | self atEnd ifTrue: [^ nil]. 274 | pos := self position. 275 | next := self next. 276 | self position: pos. 277 | ^ next. 278 | 279 | 280 | ] 281 | 282 | { #category : 'accessing' } 283 | OldMultiByteBinaryOrTextStream >> peekFor: item [ 284 | 285 | | next state | 286 | "self atEnd ifTrue: [^ false]. -- SFStream will give nil" 287 | state := converter saveStateOf: self. 288 | (next := self next) == nil ifTrue: [^ false]. 289 | item = next ifTrue: [^ true]. 290 | converter restoreStateOf: self with: state. 291 | ^ false. 292 | 293 | ] 294 | 295 | { #category : 'initialization' } 296 | OldMultiByteBinaryOrTextStream >> reset [ 297 | 298 | super reset. 299 | isBinary ifNil: [isBinary := false]. 300 | collection class == ByteArray ifTrue: ["Store as String and convert as needed." 301 | collection := collection asString. 302 | isBinary := true]. 303 | 304 | self converter. "ensure that we have a converter." 305 | ] 306 | 307 | { #category : 'file in/out' } 308 | OldMultiByteBinaryOrTextStream >> setConverterForCode [ 309 | 310 | | current | 311 | current := converter saveStateOf: self. 312 | self position: 0. 313 | self binary. 314 | ((self next: 3) = #[239 187 191]) ifTrue: [ 315 | self converter: UTF8TextConverter new 316 | ] ifFalse: [ 317 | self converter: MacRomanTextConverter new. 318 | ]. 319 | converter restoreStateOf: self with: current. 320 | self text. 321 | 322 | ] 323 | 324 | { #category : 'file in/out' } 325 | OldMultiByteBinaryOrTextStream >> setEncoderForSourceCodeNamed: streamName [ 326 | 327 | | l | 328 | l := streamName asLowercase. 329 | ((l endsWith: 'cs') or: [ 330 | (l endsWith: 'st') or: [ 331 | (l endsWith: ('st.gz')) or: [ 332 | (l endsWith: ('st.gz'))]]]) ifTrue: [ 333 | self converter: MacRomanTextConverter new. 334 | ^ self. 335 | ]. 336 | self converter: UTF8TextConverter new. 337 | 338 | ] 339 | 340 | { #category : 'positioning' } 341 | OldMultiByteBinaryOrTextStream >> skipSeparators [ 342 | 343 | [self atEnd] whileFalse: [ 344 | self basicNext isSeparator ifFalse: [ 345 | ^ self position: self position - 1]] 346 | 347 | 348 | ] 349 | 350 | { #category : 'accessing' } 351 | OldMultiByteBinaryOrTextStream >> skipSeparatorsAndPeekNext [ 352 | 353 | "A special function to make nextChunk fast" 354 | | peek pos | 355 | [self atEnd] whileFalse: [ 356 | pos := self position. 357 | (peek := self next) isSeparator ifFalse: [ 358 | self position: pos. 359 | ^ peek. 360 | ]. 361 | ]. 362 | 363 | ] 364 | 365 | { #category : 'modes' } 366 | OldMultiByteBinaryOrTextStream >> text [ 367 | isBinary := false 368 | 369 | ] 370 | 371 | { #category : 'accessing' } 372 | OldMultiByteBinaryOrTextStream >> upTo: delim [ 373 | 374 | | out ch | 375 | out := (String new: 1000) writeStream. 376 | self atEnd ifTrue: [^ '']. 377 | [(ch := self next) isNil] whileFalse: [ 378 | (ch = delim) ifTrue: [ 379 | ^ out contents "terminator is not doubled; we're done!" 380 | ]. 381 | out nextPut: ch. 382 | ]. 383 | ^ out contents. 384 | 385 | ] 386 | 387 | { #category : 'accessing' } 388 | OldMultiByteBinaryOrTextStream >> upToEnd [ 389 | 390 | | newStream element newCollection | 391 | newCollection := self isBinary 392 | ifTrue: [ByteArray new: 100] 393 | ifFalse: [String new: 100]. 394 | newStream := newCollection writeStream. 395 | [(element := self next) notNil] 396 | whileTrue: [newStream nextPut: element]. 397 | ^ newStream contents 398 | 399 | ] 400 | -------------------------------------------------------------------------------- /repository/OldFileStream/OldMultiByteFileStream.class.st: -------------------------------------------------------------------------------- 1 | " 2 | The central class to access the external file. The interface of this object is similar to good old StandardFileStream, but internally it asks the converter, which is a sub-instance of TextConverter, and do the text conversion. 3 | 4 | It also combined the good old CrLfFileStream. CrLfFileStream class>>new now returns an instance of MultiByteFileStream. 5 | 6 | There are several pitfalls: 7 | 8 | * You always have to be careful about the binary/text distinction. In #text mode, it usually interpret the bytes. 9 | * A few file pointer operations treat the file as uninterpreted byte no matter what. This means that if you use 'fileStream skip: -1', 'fileStream position: x', etc. in #text mode, the file position can be in the middle of multi byte character. If you want to implement some function similar to #peek for example, call the saveStateOf: and restoreStateOf: methods to be able to get back to the original state. 10 | * #lineEndConvention: and #wantsLineEndConversion: (and #binary) can cause some puzzling situation because the inst var lineEndConvention and wantsLineEndConversion are mutated. If you have any suggestions to clean up the protocol, please let me know. 11 | " 12 | Class { 13 | #name : 'OldMultiByteFileStream', 14 | #superclass : 'OldStandardFileStream', 15 | #instVars : [ 16 | 'converter', 17 | 'lineEndConvention', 18 | 'wantsLineEndConversion' 19 | ], 20 | #classVars : [ 21 | 'Cr', 22 | 'CrLf', 23 | 'Lf', 24 | 'LineEndDefault', 25 | 'LineEndStrings', 26 | 'LookAheadCount' 27 | ], 28 | #category : 'OldFileStream-Base', 29 | #package : 'OldFileStream', 30 | #tag : 'Base' 31 | } 32 | 33 | { #category : 'defaults' } 34 | OldMultiByteFileStream class >> defaultToCR [ 35 | 36 | "MultiByteFileStream defaultToCR" 37 | LineEndDefault := #cr. 38 | 39 | ] 40 | 41 | { #category : 'defaults' } 42 | OldMultiByteFileStream class >> defaultToCRLF [ 43 | 44 | "MultiByteFileStream defaultToCRLF" 45 | LineEndDefault := #crlf. 46 | ] 47 | 48 | { #category : 'defaults' } 49 | OldMultiByteFileStream class >> defaultToLF [ 50 | 51 | "MultiByteFileStream defaultToLF" 52 | LineEndDefault := #lf. 53 | 54 | ] 55 | 56 | { #category : 'defaults' } 57 | OldMultiByteFileStream class >> guessDefaultLineEndConvention [ 58 | "Lets try to guess the line end convention from what we know about the 59 | path name delimiter from FileDirectory." 60 | 61 | FileSystem disk delimiter = $: 62 | ifTrue: [^ self defaultToCR]. 63 | 64 | FileSystem disk delimiter = $/ 65 | ifTrue: [^ (Smalltalk os isMacOSX or: [Smalltalk os isUnix]) 66 | ifTrue: [ self defaultToLF] 67 | ifFalse: [ self defaultToCR]]. 68 | 69 | FileSystem disk delimiter = $\ 70 | ifTrue: [^ self defaultToCRLF]. 71 | 72 | "in case we don't know" 73 | ^ self defaultToCR 74 | ] 75 | 76 | { #category : 'class initialization' } 77 | OldMultiByteFileStream class >> initialize [ 78 | Cr := Character cr. 79 | Lf := Character lf. 80 | CrLf := String with: Cr with: Lf. 81 | LineEndStrings := Dictionary new. 82 | LineEndStrings at: #cr put: (String with: Character cr). 83 | LineEndStrings at: #lf put: (String with: Character lf). 84 | LineEndStrings at: #crlf put: (String with: Character cr with: Character lf). 85 | LookAheadCount := 2048. 86 | 87 | SessionManager default registerSystemClassNamed: self name. 88 | self startUp. 89 | 90 | ] 91 | 92 | { #category : 'accessing' } 93 | OldMultiByteFileStream class >> lineEndDefault [ 94 | "Answer the default line-ending convention that will be used by default, which was determined at start-up by looking at platform attributes." 95 | ^ LineEndDefault 96 | 97 | ] 98 | 99 | { #category : 'instance creation' } 100 | OldMultiByteFileStream class >> newFrom: aFileStream [ 101 | 102 | | rw n | 103 | n := aFileStream name. 104 | rw := aFileStream isReadOnly not. 105 | aFileStream close. 106 | ^self new open: n forWrite: rw. 107 | 108 | ] 109 | 110 | { #category : 'system startup' } 111 | OldMultiByteFileStream class >> startUp [ 112 | self guessDefaultLineEndConvention. 113 | 114 | ] 115 | 116 | { #category : 'system startup' } 117 | OldMultiByteFileStream class >> startUp: resuming [ 118 | self guessDefaultLineEndConvention. 119 | 120 | ] 121 | 122 | { #category : 'remnant' } 123 | OldMultiByteFileStream >> accepts: aSymbol [ 124 | 125 | ^ converter accepts: aSymbol. 126 | 127 | ] 128 | 129 | { #category : 'modes' } 130 | OldMultiByteFileStream >> ascii [ 131 | 132 | super ascii. 133 | self detectLineEndConvention. 134 | 135 | ] 136 | 137 | { #category : 'private - crlf' } 138 | OldMultiByteFileStream >> bareNext [ 139 | 140 | ^ self converter nextFromStream: self. 141 | 142 | ] 143 | 144 | { #category : 'file in/out' } 145 | OldMultiByteFileStream >> basicChunk [ 146 | "If our buffer in collection contains an chunk with no embedded !'s, nor 147 | any non-ascii characters, return that. 148 | This presumes the source code encoding is unambiguously ascii-compatible" 149 | | bufferIX goodString | 150 | "Not possible if read buffering disabled" 151 | collection ifNil: [^nil]. 152 | ^ ((bufferIX := (collection indexOf: $! startingAt: position + 1) min: readLimit +1) > 0 153 | and: [bufferIX < collection size 154 | and: [(collection at: bufferIX + 1) 155 | ~= $! 156 | and: [goodString := collection copyFrom: position + 1 to: bufferIX - 1. 157 | goodString isAsciiString]]]) 158 | ifTrue: [ position := bufferIX. 159 | goodString] 160 | ] 161 | 162 | { #category : 'private' } 163 | OldMultiByteFileStream >> basicNext: anInteger [ 164 | 165 | ^ super next: anInteger. 166 | 167 | ] 168 | 169 | { #category : 'private' } 170 | OldMultiByteFileStream >> basicNext: n into: aString [ 171 | 172 | ^ super next: n into: aString. 173 | 174 | ] 175 | 176 | { #category : 'private' } 177 | OldMultiByteFileStream >> basicNext: anInteger putAll: aCollection startingAt: startIndex [ 178 | 179 | 180 | ^super next: anInteger putAll: aCollection startingAt: startIndex 181 | ] 182 | 183 | { #category : 'private' } 184 | OldMultiByteFileStream >> basicNextInto: aString [ 185 | 186 | ^ super nextInto: aString. 187 | 188 | ] 189 | 190 | { #category : 'private' } 191 | OldMultiByteFileStream >> basicNextPut: char [ 192 | 193 | ^ super nextPut: char. 194 | 195 | ] 196 | 197 | { #category : 'private' } 198 | OldMultiByteFileStream >> basicNextPutAll: aString [ 199 | 200 | ^ super nextPutAll: aString. 201 | 202 | ] 203 | 204 | { #category : 'private' } 205 | OldMultiByteFileStream >> basicPeek [ 206 | 207 | ^ super peek 208 | 209 | ] 210 | 211 | { #category : 'private' } 212 | OldMultiByteFileStream >> basicPosition [ 213 | 214 | ^ super position. 215 | 216 | ] 217 | 218 | { #category : 'private' } 219 | OldMultiByteFileStream >> basicPosition: pos [ 220 | 221 | ^ super position: pos. 222 | 223 | ] 224 | 225 | { #category : 'private' } 226 | OldMultiByteFileStream >> basicReadInto: byteArray startingAt: startIndex count: count [ 227 | 228 | ^ super readInto: byteArray startingAt: startIndex count: count. 229 | 230 | ] 231 | 232 | { #category : 'private' } 233 | OldMultiByteFileStream >> basicSetToEnd [ 234 | 235 | ^ super setToEnd. 236 | 237 | ] 238 | 239 | { #category : 'private' } 240 | OldMultiByteFileStream >> basicSkip: n [ 241 | 242 | ^ super skip: n. 243 | 244 | ] 245 | 246 | { #category : 'private' } 247 | OldMultiByteFileStream >> basicUpTo: delim [ 248 | 249 | ^ super upTo: delim. 250 | 251 | ] 252 | 253 | { #category : 'private' } 254 | OldMultiByteFileStream >> basicVerbatim: aString [ 255 | 256 | ^ super verbatim: aString. 257 | 258 | ] 259 | 260 | { #category : 'modes' } 261 | OldMultiByteFileStream >> binary [ 262 | 263 | super binary. 264 | self lineEndConvention: nil 265 | ] 266 | 267 | { #category : 'private - crlf' } 268 | OldMultiByteFileStream >> convertStringFromCr: aString [ 269 | | inStream outStream | 270 | lineEndConvention ifNil: [^ aString]. 271 | lineEndConvention == #cr ifTrue: [^ aString]. 272 | lineEndConvention == #lf ifTrue: [^ aString copy replaceAll: Cr with: Lf]. 273 | "lineEndConvention == #crlf" 274 | inStream := aString readStream. 275 | outStream := (String new: aString size) writeStream. 276 | [inStream atEnd] 277 | whileFalse: 278 | [outStream nextPutAll: (inStream upTo: Cr). 279 | (inStream atEnd not or: [aString last = Cr]) 280 | ifTrue: [outStream nextPutAll: CrLf]]. 281 | ^ outStream contents 282 | ] 283 | 284 | { #category : 'private - crlf' } 285 | OldMultiByteFileStream >> convertStringToCr: aString [ 286 | | inStream outStream | 287 | lineEndConvention ifNil: [^ aString]. 288 | lineEndConvention == #cr ifTrue: [^ aString]. 289 | lineEndConvention == #lf ifTrue: [^ aString copy replaceAll: Lf with: Cr]. 290 | "lineEndConvention == #crlf" 291 | inStream := aString readStream. 292 | outStream := (String new: aString size) writeStream. 293 | [inStream atEnd] 294 | whileFalse: 295 | [outStream nextPutAll: (inStream upTo: Cr). 296 | (inStream atEnd not or: [aString last = Cr]) 297 | ifTrue: 298 | [outStream nextPut: Cr. 299 | inStream peek = Lf ifTrue: [inStream next]]]. 300 | ^ outStream contents 301 | ] 302 | 303 | { #category : 'accessing' } 304 | OldMultiByteFileStream >> converter [ 305 | 306 | converter ifNil: [self converter: TextConverter defaultSystemConverter]. 307 | ^ converter 308 | 309 | ] 310 | 311 | { #category : 'accessing' } 312 | OldMultiByteFileStream >> converter: aConverter [ 313 | 314 | converter := aConverter. 315 | self installLineEndConventionInConverter 316 | 317 | ] 318 | 319 | { #category : 'private - crlf' } 320 | OldMultiByteFileStream >> detectLineEndConvention [ 321 | "Detect the line end convention used in this stream. The result may be either #cr, #lf or #crlf." 322 | | char numRead state | 323 | self isBinary ifTrue: [^ self error: 'Line end conventions are not used on binary streams']. 324 | wantsLineEndConversion == true ifFalse: [self lineEndConvention: nil. 325 | ^lineEndConvention]. 326 | self closed ifTrue: [self lineEndConvention: LineEndDefault. 327 | ^lineEndConvention]. 328 | 329 | "Default if nothing else found" 330 | numRead := 0. 331 | state := self converter saveStateOf: self. 332 | lineEndConvention := nil. 333 | [super atEnd not and: [numRead < LookAheadCount]] 334 | whileTrue: 335 | [char := self next. 336 | char = Lf 337 | ifTrue: 338 | [converter restoreStateOf: self with: state. 339 | self lineEndConvention: #lf. 340 | ^lineEndConvention]. 341 | char = Cr 342 | ifTrue: 343 | [self peek = Lf 344 | ifTrue: [self lineEndConvention: #crlf] 345 | ifFalse: [self lineEndConvention: #cr]. 346 | converter restoreStateOf: self with: state. 347 | ^ lineEndConvention]. 348 | numRead := numRead + 1]. 349 | converter restoreStateOf: self with: state. 350 | self lineEndConvention: LineEndDefault. 351 | ^ lineEndConvention 352 | ] 353 | 354 | { #category : 'private - crlf' } 355 | OldMultiByteFileStream >> doConversion [ 356 | 357 | ^wantsLineEndConversion == true and: [ lineEndConvention notNil ] 358 | ] 359 | 360 | { #category : 'accessing' } 361 | OldMultiByteFileStream >> fileInEncodingName: aString [ 362 | 363 | self converter: (TextConverter newForEncoding: aString). 364 | super fileIn. 365 | 366 | ] 367 | 368 | { #category : 'private' } 369 | OldMultiByteFileStream >> installLineEndConventionInConverter [ 370 | 371 | converter ifNotNil: [ 372 | converter installLineEndConvention: ( 373 | (wantsLineEndConversion == true and: [ lineEndConvention notNil ]) "#doConversion is inlined here" 374 | ifTrue: [ LineEndStrings at: lineEndConvention ] 375 | ifFalse: [ nil ]) ] 376 | ] 377 | 378 | { #category : 'accessing' } 379 | OldMultiByteFileStream >> lineEndConvention [ 380 | 381 | ^lineEndConvention 382 | ] 383 | 384 | { #category : 'accessing' } 385 | OldMultiByteFileStream >> lineEndConvention: aSymbol [ 386 | 387 | (lineEndConvention := aSymbol) ifNotNil: [wantsLineEndConversion := true]. 388 | self installLineEndConventionInConverter 389 | ] 390 | 391 | { #category : 'accessing' } 392 | OldMultiByteFileStream >> next [ 393 | 394 | | char secondChar state | 395 | char := (converter ifNil: [ self converter ]) nextFromStream: self. 396 | (wantsLineEndConversion == true and: [ lineEndConvention notNil ]) "#doConversion is inlined here" 397 | ifTrue: [ 398 | char == Cr ifTrue: [ 399 | state := converter saveStateOf: self. 400 | secondChar := self bareNext. 401 | secondChar ifNotNil: [ 402 | secondChar == Lf ifFalse: [ converter restoreStateOf: self with: state ] ]. 403 | ^Cr ]. 404 | char == Lf ifTrue: [ 405 | ^Cr ] ]. 406 | ^char. 407 | 408 | 409 | ] 410 | 411 | { #category : 'accessing' } 412 | OldMultiByteFileStream >> next: anInteger [ 413 | 414 | | multiString | 415 | self isBinary ifTrue: [^ super next: anInteger]. 416 | multiString := String new: anInteger. 417 | 1 to: anInteger do: [:index | 418 | | character | 419 | (character := self next) 420 | ifNotNil: [ multiString at: index put: character ] 421 | ifNil: [ 422 | multiString := multiString copyFrom: 1 to: index - 1. 423 | (wantsLineEndConversion == true and: [ lineEndConvention notNil ]) "#doConversion is inlined here" 424 | ifFalse: [ ^multiString ]. 425 | ^self next: anInteger innerFor: multiString ] ]. 426 | (wantsLineEndConversion == true and: [ lineEndConvention notNil ]) "#doConversion is inlined here" 427 | ifFalse: [ ^multiString ]. 428 | 429 | multiString := self next: anInteger innerFor: multiString. 430 | (multiString size = anInteger or: [self atEnd]) ifTrue: [ ^ multiString]. 431 | ^ multiString, (self next: anInteger - multiString size). 432 | 433 | ] 434 | 435 | { #category : 'private - crlf' } 436 | OldMultiByteFileStream >> next: n innerFor: aString [ 437 | 438 | | peekChar state | 439 | "if we just read a CR, and the next character is an LF, then skip the LF" 440 | aString size = 0 ifTrue: [^ aString]. 441 | (aString last = Character cr) ifTrue: [ 442 | state := converter saveStateOf: self. 443 | peekChar := self bareNext. "super peek doesn't work because it relies on #next" 444 | (peekChar notNil and: [peekChar ~= Character lf]) ifTrue: [ 445 | converter restoreStateOf: self with: state. 446 | ]. 447 | ]. 448 | 449 | ^ aString withInternalLineEndings. 450 | 451 | ] 452 | 453 | { #category : 'accessing' } 454 | OldMultiByteFileStream >> next: anInteger putAll: aCollection startingAt: startIndex [ 455 | 456 | 457 | (self isBinary or: [ aCollection class == ByteArray ]) ifTrue: [ 458 | ^super next: anInteger putAll: aCollection startingAt: startIndex ]. 459 | ^self converter next: anInteger putAll: aCollection startingAt: startIndex toStream: self 460 | ] 461 | 462 | { #category : 'file in/out' } 463 | OldMultiByteFileStream >> nextChunk [ 464 | "Answer the contents of the receiver, up to the next terminator 465 | character. Doubled terminators indicate an embedded terminator 466 | character." 467 | self skipSeparators. 468 | ^ self 469 | parseLangTagFor: (self basicChunk 470 | ifNil: [String 471 | new: 1000 472 | streamContents: [:stream | 473 | | character state | 474 | [(character := self next) == nil 475 | or: [character == $! 476 | and: [state := converter saveStateOf: self. 477 | self next ~~ $!]]] 478 | whileFalse: [stream nextPut: character]. 479 | character 480 | ifNotNil: [converter restoreStateOf: self with: state.]]]) 481 | ] 482 | 483 | { #category : 'accessing' } 484 | OldMultiByteFileStream >> nextDelimited: terminator [ 485 | 486 | | out ch save | 487 | out := (String new: 1000) writeStream. 488 | self atEnd ifTrue: [^ '']. 489 | save := converter saveStateOf: self. 490 | 491 | self next = terminator ifFalse: [ 492 | "absorb initial terminator" 493 | converter restoreStateOf: self with: save. 494 | ]. 495 | [(ch := self next) == nil] whileFalse: [ 496 | (ch = terminator) ifTrue: [ 497 | self peek = terminator ifTrue: [ 498 | self next. "skip doubled terminator" 499 | ] ifFalse: [ 500 | ^ out contents "terminator is not doubled; we're done!" 501 | ]. 502 | ]. 503 | out nextPut: ch. 504 | ]. 505 | ^ out contents. 506 | 507 | ] 508 | 509 | { #category : 'accessing' } 510 | OldMultiByteFileStream >> nextMatchAll: aColl [ 511 | 512 | | save | 513 | save := converter saveStateOf: self. 514 | aColl do: [:each | 515 | (self next) = each ifFalse: [ 516 | converter restoreStateOf: self with: save. 517 | ^ false. 518 | ]. 519 | ]. 520 | ^ true. 521 | 522 | ] 523 | 524 | { #category : 'file in/out' } 525 | OldMultiByteFileStream >> nextPreamble [ 526 | "Assuming that preamble part does not contain ]lang[ tag" 527 | self skipSeparators. 528 | ^ self basicChunk 529 | ifNil: [String 530 | new: 1000 531 | streamContents: [:stream | 532 | | character state | 533 | [(character := self next) == nil 534 | or: [character == $! 535 | and: [state := converter saveStateOf: self. 536 | self next ~~ $!]]] 537 | whileFalse: [stream nextPut: character]. 538 | character 539 | ifNotNil: [converter restoreStateOf: self with: state.]]] 540 | ] 541 | 542 | { #category : 'accessing' } 543 | OldMultiByteFileStream >> nextPut: aCharacter [ 544 | aCharacter isInteger 545 | ifTrue: [ ^ super nextPut: aCharacter ]. 546 | (wantsLineEndConversion == true and: [ lineEndConvention notNil ]) "#doConversion is inlined here" 547 | ifTrue: [ 548 | aCharacter = Cr 549 | ifTrue: [ converter nextPutAll: (LineEndStrings at: lineEndConvention) toStream: self ] 550 | ifFalse: [ converter nextPut: aCharacter toStream: self ]. 551 | ^aCharacter ]. 552 | ^ self converter nextPut: aCharacter toStream: self 553 | 554 | ] 555 | 556 | { #category : 'accessing' } 557 | OldMultiByteFileStream >> nextPutAll: aCollection [ 558 | ^ (self isBinary or: [ aCollection class == ByteArray ]) 559 | ifTrue: [ super nextPutAll: aCollection ] 560 | ifFalse: [ self converter nextPutAll: aCollection toStream: self ] 561 | ] 562 | 563 | { #category : 'open/close' } 564 | OldMultiByteFileStream >> open: fileName forWrite: writeMode [ 565 | | result | 566 | 567 | (writeMode and: [SessionManager default currentSession isReadOnlyAccessMode]) 568 | ifTrue: [ ((CannotDeleteFileException fileName: fileName) 569 | messageText: 'Attempt to open file ' , fileName, ' as writable on read-only filesystem') signal. ]. 570 | 571 | result := super open: fileName forWrite: writeMode. 572 | result ifNotNil: [ 573 | converter ifNil: [self converter: UTF8TextConverter new]. 574 | lineEndConvention ifNil: [ self detectLineEndConvention ] 575 | ]. 576 | ^result 577 | ] 578 | 579 | { #category : 'accessing' } 580 | OldMultiByteFileStream >> peek [ 581 | "Answer what would be returned if the message next were sent to the receiver. If the receiver is at the end, answer nil. " 582 | 583 | | next save | 584 | self atEnd ifTrue: [^ nil]. 585 | save := converter saveStateOf: self. 586 | next := self next. 587 | converter restoreStateOf: self with: save. 588 | ^ next. 589 | 590 | 591 | ] 592 | 593 | { #category : 'accessing' } 594 | OldMultiByteFileStream >> peekFor: item [ 595 | 596 | | next state | 597 | state := converter saveStateOf: self. 598 | (next := self next) == nil ifTrue: [^ false]. 599 | item = next ifTrue: [^ true]. 600 | converter restoreStateOf: self with: state. 601 | ^ false. 602 | 603 | ] 604 | 605 | { #category : 'accessing' } 606 | OldMultiByteFileStream >> readInto: buffer startingAt: offset count: requestedCount [ 607 | "Read up to requestedCount elements into the given buffer starting at offset. 608 | Return the number of elements actually read. 609 | If I am binary or if buffer is a ByteArray, I skip decoding. Yes this is weird. 610 | This is a necessarily inefficient implementation, reading and decoding characters one by one." 611 | 612 | (self isBinary or: [ buffer class == ByteArray ]) 613 | ifTrue: [ ^ super readInto: buffer startingAt: offset count: requestedCount ]. 614 | 0 to: requestedCount - 1 do: [ :count | 615 | | element | 616 | (element := self next) ifNil: [ ^ count ]. 617 | buffer at: offset + count put: element ]. 618 | ^ requestedCount 619 | ] 620 | 621 | { #category : 'private' } 622 | OldMultiByteFileStream >> requestDropStream: dropIndex [ 623 | "Needs to install proper converter" 624 | 625 | | result | 626 | result := super requestDropStream: dropIndex. 627 | result ifNotNil: [ 628 | converter ifNil: [self converter: UTF8TextConverter new]. 629 | lineEndConvention ifNil: [ self detectLineEndConvention] ]. 630 | ^result 631 | ] 632 | 633 | { #category : 'initialization' } 634 | OldMultiByteFileStream >> reset [ 635 | 636 | super reset. 637 | converter ifNil: [ 638 | self converter: UTF8TextConverter new. 639 | ]. 640 | 641 | ] 642 | 643 | { #category : 'private' } 644 | OldMultiByteFileStream >> setConverterForCode [ 645 | 646 | | current | 647 | SourceFiles changesFileStream ifNotNil: [ :aStream | 648 | self fullName = aStream fullName ifTrue: [ ^ self ] ]. 649 | current := self converter saveStateOf: self. 650 | self position: 0. 651 | self binary. 652 | ((self next: 3) = #[ 16rEF 16rBB 16rBF ]) ifTrue: [ 653 | self converter: UTF8TextConverter new 654 | ] ifFalse: [ 655 | self converter: MacRomanTextConverter new. 656 | ]. 657 | converter restoreStateOf: self with: current. 658 | self text. 659 | 660 | ] 661 | 662 | { #category : 'positioning' } 663 | OldMultiByteFileStream >> skipSeparators [ 664 | 665 | | state character | 666 | [ 667 | state := converter saveStateOf: self. 668 | (character := self next) 669 | ifNil: [ false ] 670 | ifNotNil: [ character isSeparator ] ] whileTrue. 671 | character ifNotNil: [ 672 | converter restoreStateOf: self with: state ] 673 | ] 674 | 675 | { #category : 'accessing' } 676 | OldMultiByteFileStream >> skipSeparatorsAndPeekNext [ 677 | "Same as #skipSeparators, but returns the next character after the separators if such exists." 678 | 679 | | state character | 680 | [ 681 | state := converter saveStateOf: self. 682 | (character := self next) 683 | ifNil: [ false ] 684 | ifNotNil: [ character isSeparator ] ] whileTrue. 685 | character ifNotNil: [ 686 | converter restoreStateOf: self with: state. 687 | ^character ]. 688 | 689 | ] 690 | 691 | { #category : 'accessing' } 692 | OldMultiByteFileStream >> upTo: delimiter [ 693 | 694 | ^self collectionSpecies new: 1000 streamContents: [ :stream | 695 | | ch | 696 | [ (ch := self next) == nil or: [ ch = delimiter ] ] 697 | whileFalse: [ stream nextPut: ch ] ] 698 | 699 | ] 700 | 701 | { #category : 'accessing' } 702 | OldMultiByteFileStream >> upToAnyOf: delimiters do: aBlock [ 703 | 704 | ^self collectionSpecies new: 1000 streamContents: [ :stream | 705 | | ch | 706 | [ (ch := self next) == nil or: [ (delimiters includes: ch) and: [aBlock value: ch. true] ] ] 707 | whileFalse: [ stream nextPut: ch ] ] 708 | ] 709 | 710 | { #category : 'accessing' } 711 | OldMultiByteFileStream >> upToEnd [ 712 | 713 | ^self collectionSpecies 714 | new: self size - self position 715 | streamContents: [ :stream | 716 | | element | 717 | [ (element := self next) == nil ] whileFalse: [ 718 | stream nextPut: element ] ] 719 | 720 | ] 721 | 722 | { #category : 'accessing' } 723 | OldMultiByteFileStream >> upToPosition: anInteger [ 724 | "Answer a subcollection containing items starting from the current position and ending including the given position. Usefully different to #next: in that positions measure *bytes* from the file, where #next: wants to measure *characters*." 725 | ^self collectionSpecies new: 1000 streamContents: [ :stream | 726 | | ch | 727 | [ (ch := self next) == nil or: [ position > anInteger ] ] 728 | whileFalse: [ stream nextPut: ch ] ] 729 | ] 730 | 731 | { #category : 'private - crlf' } 732 | OldMultiByteFileStream >> wantsLineEndConversion [ 733 | 734 | ^wantsLineEndConversion == true 735 | 736 | ] 737 | 738 | { #category : 'remnant' } 739 | OldMultiByteFileStream >> wantsLineEndConversion: aBoolean [ 740 | 741 | wantsLineEndConversion := aBoolean. 742 | 743 | lineEndConvention ifNil: [ self detectLineEndConvention ]. 744 | ] 745 | -------------------------------------------------------------------------------- /repository/OldFileStream/OldRWBinaryOrTextStream.class.st: -------------------------------------------------------------------------------- 1 | " 2 | This package is to support the migration of OSSubProcess to Pharo 9.0 where FileStream has been removed after been deprecated in Pharo 8.0. 3 | 4 | 5 | 6 | 7 | A simulation of a FileStream, but living totally in memory. Hold the contents of a file or web page from the network. Can then fileIn like a normal FileStream. 8 | 9 | Need to be able to switch between binary and text, as a FileStream does, without recopying the whole collection. Convert to binary upon input and output. Always keep as text internally. 10 | " 11 | Class { 12 | #name : 'OldRWBinaryOrTextStream', 13 | #superclass : 'ReadWriteStream', 14 | #instVars : [ 15 | 'isBinary' 16 | ], 17 | #category : 'OldFileStream-Base', 18 | #package : 'OldFileStream', 19 | #tag : 'Base' 20 | } 21 | 22 | { #category : 'deprecation' } 23 | OldRWBinaryOrTextStream class >> isDeprecated [ 24 | ^true 25 | ] 26 | 27 | { #category : 'converting' } 28 | OldRWBinaryOrTextStream >> asBinaryOrTextStream [ 29 | 30 | ^ self 31 | ] 32 | 33 | { #category : 'modes' } 34 | OldRWBinaryOrTextStream >> ascii [ 35 | isBinary := false 36 | ] 37 | 38 | { #category : 'modes' } 39 | OldRWBinaryOrTextStream >> binary [ 40 | isBinary := true 41 | ] 42 | 43 | { #category : 'accessing' } 44 | OldRWBinaryOrTextStream >> contents [ 45 | "Answer with a copy of my collection from 1 to readLimit." 46 | 47 | | newArray | 48 | readLimit := readLimit max: position. 49 | isBinary ifFalse: [ "String" 50 | ^ collection copyFrom: 1 to: readLimit]. 51 | newArray := ByteArray new: readLimit. 52 | ^ newArray replaceFrom: 1 53 | to: readLimit 54 | with: collection 55 | startingAt: 1. 56 | ] 57 | 58 | { #category : 'testing' } 59 | OldRWBinaryOrTextStream >> isBinary [ 60 | ^ isBinary 61 | ] 62 | 63 | { #category : 'accessing' } 64 | OldRWBinaryOrTextStream >> next [ 65 | 66 | | byte | 67 | ^ isBinary 68 | ifTrue: [byte := super next. 69 | byte ifNil: [nil] ifNotNil: [byte asciiValue]] 70 | ifFalse: [super next]. 71 | 72 | ] 73 | 74 | { #category : 'accessing' } 75 | OldRWBinaryOrTextStream >> next: anInteger [ 76 | "Answer the next anInteger elements of my collection. Must override to get class right." 77 | 78 | | newArray | 79 | newArray := (isBinary ifTrue: [ByteArray] ifFalse: [ByteString]) new: anInteger. 80 | ^ self nextInto: newArray 81 | ] 82 | 83 | { #category : 'accessing' } 84 | OldRWBinaryOrTextStream >> next: n into: aCollection startingAt: startIndex [ 85 | "Read n objects into the given collection. 86 | Return aCollection or a partial copy if less than n elements have been read." 87 | "Overriden for efficiency" 88 | | max | 89 | max := (readLimit - position) min: n. 90 | aCollection 91 | replaceFrom: startIndex 92 | to: startIndex+max-1 93 | with: collection 94 | startingAt: position+1. 95 | position := position + max. 96 | max = n 97 | ifTrue:[^aCollection] 98 | ifFalse:[^aCollection copyFrom: 1 to: startIndex+max-1] 99 | ] 100 | 101 | { #category : 'accessing' } 102 | OldRWBinaryOrTextStream >> next: anInteger putAll: aCollection startingAt: startIndex [ 103 | "Optimized for ByteArrays" 104 | aCollection class == ByteArray 105 | ifTrue:[^super next: anInteger putAll: aCollection asString startingAt: startIndex]. 106 | ^super next: anInteger putAll: aCollection startingAt: startIndex 107 | ] 108 | 109 | { #category : 'accessing' } 110 | OldRWBinaryOrTextStream >> nextPut: charOrByte [ 111 | ^ super nextPut: charOrByte asCharacter 112 | ] 113 | 114 | { #category : 'accessing' } 115 | OldRWBinaryOrTextStream >> nextPutAll: aCollection [ 116 | "Optimized for ByteArrays" 117 | ^ aCollection class == ByteArray 118 | ifTrue: [ super nextPutAll: aCollection asString ] 119 | ifFalse: [ super nextPutAll: aCollection ] 120 | ] 121 | 122 | { #category : 'converting' } 123 | OldRWBinaryOrTextStream >> on: aCollection [ 124 | 125 | super on: aCollection. 126 | readLimit := 0 127 | ] 128 | 129 | { #category : 'accessing' } 130 | OldRWBinaryOrTextStream >> padToEndWith: aChar [ 131 | "We don't have pages, so we are at the end, and don't need to pad." 132 | ] 133 | 134 | { #category : 'accessing' } 135 | OldRWBinaryOrTextStream >> readInto: aCollection startingAt: startIndex count: n [ 136 | "Read n objects into the given collection. 137 | Return number of elements that have been read." 138 | "Overriden for efficiency" 139 | | max | 140 | max := (readLimit - position) min: n. 141 | aCollection 142 | replaceFrom: startIndex 143 | to: startIndex + max - 1 144 | with: collection 145 | startingAt: position + 1. 146 | position := position + max. 147 | ^ max 148 | ] 149 | 150 | { #category : 'initialization' } 151 | OldRWBinaryOrTextStream >> reset [ 152 | "Set the receiver's position to the beginning of the sequence of objects." 153 | 154 | super reset. 155 | isBinary ifNil: [isBinary := false]. 156 | collection class == ByteArray ifTrue: ["Store as String and convert as needed." 157 | collection := collection asString. 158 | isBinary := true]. 159 | 160 | ] 161 | 162 | { #category : 'modes' } 163 | OldRWBinaryOrTextStream >> text [ 164 | isBinary := false 165 | ] 166 | 167 | { #category : 'accessing' } 168 | OldRWBinaryOrTextStream >> upTo: anObject [ 169 | "Answer a subcollection from the current access position to the 170 | occurrence (if any, but not inclusive) of anObject in the receiver. If 171 | anObject is not in the collection, answer the entire rest of the receiver." 172 | | newStream element species | 173 | species := isBinary ifTrue:[ByteArray] ifFalse:[String]. 174 | newStream := WriteStream on: (species new: 100). 175 | [self atEnd or: [(element := self next) = anObject]] 176 | whileFalse: [newStream nextPut: element]. 177 | ^newStream contents 178 | ] 179 | 180 | { #category : 'accessing' } 181 | OldRWBinaryOrTextStream >> upToEnd [ 182 | "Must override to get class right." 183 | | newArray | 184 | newArray := (isBinary ifTrue: [ByteArray] ifFalse: [ByteString]) new: self size - self position. 185 | ^ self nextInto: newArray 186 | ] 187 | -------------------------------------------------------------------------------- /repository/OldFileStream/PositionableStream.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'PositionableStream' } 2 | 3 | { #category : '*OldFileStream' } 4 | PositionableStream >> asBinaryOrTextStream [ 5 | "Convert to a stream that can switch between bytes and characters" 6 | 7 | ^ (OldRWBinaryOrTextStream with: self contentsOfEntireFile) reset 8 | ] 9 | -------------------------------------------------------------------------------- /repository/OldFileStream/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'OldFileStream' } 2 | --------------------------------------------------------------------------------