David T. Lewis uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-dtl.1201.mcz==================== Summary ====================
Name: System-dtl.1201
Author: dtl
Time: 17 December 2020, 9:48:42.965817 pm
UUID: 02a92044-45ac-40d7-b274-a29ead5778bb
Ancestors: System-mt.1200
Make DoItFirst safer on Windows and other platforms without access to stdo streams. If stdio not available, redirect output to transcript. Do not allow the image to quit if output was redirected to transcript, because otherwise command line results cannot be seen.
Also move reevalute methods to category 'system startup' to clarify their use. These are only sent from other classes in the startup list.
=============== Diff against System-mt.1200 ===============
Item was changed:
+ ----- Method: DoItFirst class>>reevaluateCwd (in category 'system startup') -----
- ----- Method: DoItFirst class>>reevaluateCwd (in category 'reevaluate options') -----
reevaluateCwd
"If a -cwd option was specified on the command line, reevaluate it now.
May be called from FileDirectory class>>startUp: to reevaluate the command line
option to ensure that the default directory is ultimately set as specified by the -cwd
image command line option."
^ self current evaluateArg: #cwd.!
Item was changed:
+ ----- Method: DoItFirst class>>reevaluateDebug (in category 'system startup') -----
- ----- Method: DoItFirst class>>reevaluateDebug (in category 'reevaluate options') -----
reevaluateDebug
"The -debug option cannot be evaluated at DoInNow startUp time, but may be called
later in the startUp processing. If -debug was not specified as a command option this
method does nothing.
May be called from Delay>>startup to invoke a debugger at the earliest possible time."
^ self current evaluateArg: #debug.!
Item was changed:
----- Method: DoItFirst>>cwd: (in category 'actions') -----
cwd: path
+ "Evaluate arg and print the result on stdout, or error message on stderr."
- "Evaluate arg and print the result on stdout, or error message on stderr.
- Exit immediately without saving the image."
(FileDirectory on: path) exists
ifTrue: [ FileDirectory setDefaultDirectory: path ]
+ ifFalse: [ (self printError: path, ': directory does not exist')
+ ifTrue: [ Smalltalk quitPrimitive ]].!
- ifFalse: [ FileStream stderr nextPutAll: path, ': directory does not exist'; lf; flush.
- Smalltalk quitPrimitive ]
- !
Item was changed:
----- Method: DoItFirst>>doIt: (in category 'actions') -----
doIt: arguments
"Evaluate arguments and print the result on stdout, or error message on stderr.
Exit the image after any error."
arguments do: [ :arg |
+ [ self printOut: (Compiler evaluate: arg) asString ]
- [FileStream stdout nextPutAll: (Compiler evaluate: arg) asString; lf; flush]
on: Error
+ do: [ :ex | self printError: ex asString ]].!
- do: [ :ex | FileStream stderr nextPutAll: ex asString; lf; flush.
- Smalltalk quitPrimitive ]]!
Item was changed:
----- Method: DoItFirst>>evaluateFileContents: (in category 'actions') -----
evaluateFileContents: fileName
"Evaluate the contents of a file and print the result on stdout, or error
message on stderr. Exit immediately without saving the image."
| fs arg |
+ [fs := FileStream oldFileNamed: fileName.
+ [arg := fs contentsOfEntireFile.
+ ^ self evaluateOption: arg]
+ ensure: [fs close]]
+ on: Exception
+ do: [:ex | (self printError: ex asString)
+ ifTrue: [Smalltalk quitPrimitive]].!
- [ [ fs := FileStream oldFileNamed: fileName. ]
- on: FileDoesNotExistException
- do: [ :ex | FileStream stderr nextPutAll: ex asString; lf; flush.
- Smalltalk quitPrimitive ].
- arg := fs contentsOfEntireFile.
- ^ self evaluateOption: arg.
- ] ensure: [ fs close ].
- !
Item was changed:
----- Method: DoItFirst>>evaluateOption: (in category 'actions') -----
evaluateOption: arg
"Evaluate option and print the result on stdout, or error message on stderr.
Exit immediately without saving the image."
+ | safeToQuit |
+ [ safeToQuit := self printOut: (Compiler evaluate: arg) asString ]
- [FileStream stdout nextPutAll: (Compiler evaluate: arg) asString; lf; flush]
on: Error
+ do: [ :ex | safeToQuit := self printError: ex asString ].
+ safeToQuit ifTrue: [ Smalltalk quitPrimitive ].!
- do: [ :ex | FileStream stderr nextPutAll: ex asString; lf; flush ].
- Smalltalk quitPrimitive!
Item was changed:
----- Method: DoItFirst>>fileIn: (in category 'actions') -----
fileIn: fileNames
"File in each named file. On error, print a message to stderr and exit the image."
fileNames do: [ :arg |
[ | fs |
fs := FileStream oldFileNamed: arg.
+ self printOut: 'file in ', fs name.
- FileStream stdout nextPutAll: 'file in ', fs name; lf; flush.
fs fileIn ]
on: Error
+ do: [ :ex | (self printError: ex asString)
+ ifTrue: [ Smalltalk quitPrimitive ]]].!
- do: [ :ex | FileStream stderr nextPutAll: ex asString; lf; flush.
- Smalltalk quitPrimitive ]]!
Item was changed:
----- Method: DoItFirst>>help (in category 'actions') -----
help
+ self printOut: self class name, ' image arguments:'.
- FileStream stdout nextPutAll: self class name, ' image arguments:'; lf.
{ '--doit argumentlist "evaluate each argument as a doIt expression"' .
'--evaluate arg "evaluate arg, print result then exit"' .
'--file filename "evaluate contents of filename, print result then exit"' .
'--filein filelist "file in each file named in fileList"' .
'--cwd path "set FileDirectory defaultDirectory to path prior to evaluating other options"' .
'--debug "enter a debugger as soon as possible in the startUp processing"'.
'--help "print this message"'
+ } do: [ :e | self printOut: String tab, e ].
+ self printOut: 'some arguments have single character synonyms, -f is a synonym for --file, -d for --doit'.
+ (self printOut: 'single ''-'' may be used instead of ''--'', -help is interpreted as --help')
+ ifTrue: [ Smalltalk quitPrimitive ]. "do not quit if output went to the transcript"!
- } do: [ :e | FileStream stdout tab; nextPutAll: e; lf ].
- FileStream stdout
- nextPutAll: 'some arguments have single character synonyms, -f is a synonym for --file, -d for --doit'; lf;
- nextPutAll: 'single ''-'' may be used instead of ''--'', -help is interpreted as --help'; lf;
- flush.
- Smalltalk quitPrimitive.
-
- !
Item was added:
+ ----- Method: DoItFirst>>print:to: (in category 'private') -----
+ print: aString to: stream
+ [ stream nextPutAll: aString; lf; flush ]
+ on: Error
+ do: [ Transcript cr; show: self class name , ' output: ', aString; flush.
+ ^false ].
+ ^true.
+ !
Item was added:
+ ----- Method: DoItFirst>>printError: (in category 'private') -----
+ printError: aString
+ "Print to stdout if available, otherwise to the transcript. Answer true if
+ the stdio stream was used, false if output was redirected to transcript."
+ ^self print: aString to: FileStream stderr.
+ !
Item was added:
+ ----- Method: DoItFirst>>printOut: (in category 'private') -----
+ printOut: aString
+ "Print to stdout if available, otherwise to the transcript. Answer true if
+ the stdio stream was used, false if output was redirected to transcript."
+ ^self print: aString to: FileStream stdout.
+ !
Locked
