Implemented proper quoting of MI commands
...as described in GDB MI documentation [1] by means of
a (new) class `GDBMIPrinter`. `GDBCommand >> asString` has been
changed to use `GDBMIPrinter`.
[1]: https://sourceware.org/gdb/onlinedocs/gdb/GDB_002fMI-Input-Syntax.html#GDB_002fMI-Input-Syntax
"{ Encoding: utf8 }"
"{ Package: 'jv:libgdbs' }"
"{ NameSpace: Smalltalk }"
Object subclass:#GDBMIPrinter
instanceVariableNames:'stream'
classVariableNames:''
poolDictionaries:''
category:'GDB-Private'
!
!GDBMIPrinter class methodsFor:'documentation'!
documentation
"
A writer that writes GDB commands to an MI channel usin
GDB MI input syntax [1].
[author:]
Jan Vrany <jan.vrany@fit.cvut.cz>
[instance variables:]
[class variables:]
[see also:]
[1]: https://sourceware.org/gdb/onlinedocs/gdb/GDB_002fMI-Input-Syntax.html#GDB_002fMI-Input-Syntax
"
! !
!GDBMIPrinter class methodsFor:'instance creation'!
on: aStream
^ self new setStream: aStream.
"Created: / 11-07-2017 / 21:21:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!GDBMIPrinter methodsFor:'initialization'!
setStream: aStream
stream := aStream
"Created: / 11-07-2017 / 21:22:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!GDBMIPrinter methodsFor:'printing'!
printCEscapedCharacter: aCharacter
stream nextPut: $\.
aCharacter == $" ifTrue:[ stream nextPut: $". ^ self ].
aCharacter == $\ ifTrue:[ stream nextPut: $\. ^ self ].
aCharacter == Character backspace ifTrue:[ stream nextPut: $b. ^ self ].
aCharacter == Character tab ifTrue:[ stream nextPut: $t. ^ self ].
aCharacter == Character linefeed ifTrue:[ stream nextPut: $n. ^ self ].
aCharacter == Character return ifTrue:[ stream nextPut: $r. ^ self ].
aCharacter == Character newPage ifTrue:[ stream nextPut: $f. ^ self ].
aCharacter codePoint <= 16rFF ifTrue:[
stream nextPut: $x.
aCharacter codePoint printOn: stream base: 16.
^ self.
].
GDBError raiseErrorString: 'Unrepresentable character: \U', (aCharacter codePoint printStringRadix: 16)
"Created: / 11-07-2017 / 22:12:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
printCString: aString
"
c-string → ''' seven-bit-iso-c-string-content '''
"
| start stop |
stream nextPut: $".
start := 1.
[ start <= aString size ] whileTrue:[
| char |
stop := start.
[
stop > aString size ifTrue:[
stream nextPutAll:aString startingAt: start to: stop - 1.
stream nextPut: $".
^ self.
].
char := aString at: stop.
stop := stop + 1.
char == Character space or:[(self needCEscaping: char) not] ] whileTrue.
stream nextPutAll:aString startingAt: start to: stop - 2.
self printCEscapedCharacter: char.
start := stop.
].
stream nextPut: $".
"Created: / 11-07-2017 / 22:05:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
printCommand: aGDBCommand
"
command → cli-command | mi-command
"
aGDBCommand isMICommand ifTrue:[
self printCommandMI: aGDBCommand
] ifFalse:[
self printCommandCLI: aGDBCommand.
].
"Created: / 11-07-2017 / 21:29:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
printCommandCLI: aGDBCLICommand
"
cli-command → [ token ] cli-command nl, where cli-command is any existing GDB CLI command.
"
aGDBCLICommand token notNil ifTrue:[
aGDBCLICommand token printOn: stream.
].
stream nextPutAll: aGDBCLICommand value.
"Created: / 11-07-2017 / 21:33:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
printCommandMI: aGDBMICommand
"
mi-command → [ token ] '-' operation ( ' ' option )* [ ' --' ] ( ' ' parameter )* nl
"
| maybeOption |
aGDBMICommand token notNil ifTrue:[
aGDBMICommand token printOn: stream.
].
stream nextPut:$-; nextPutAll: aGDBMICommand operation.
"/ Now, this is tricky. We have no distinction between options :-(
maybeOption := true.
aGDBMICommand arguments notEmptyOrNil ifTrue:[
aGDBMICommand arguments do:[:each |
| eachAsString |
eachAsString := each asString.
stream space.
eachAsString = '--' ifTrue:[
maybeOption := false.
stream nextPutAll: '--'.
].
(maybeOption and:[eachAsString first = $-]) ifTrue:[
self printOption: eachAsString
] ifFalse:[
self printParameter: eachAsString.
].
].
].
"Created: / 11-07-2017 / 21:36:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 11-07-2017 / 22:56:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
printNl
"
nl → CR | CR-LF
"
stream nextPut: Character return.
"Created: / 11-07-2017 / 21:33:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
printNonBlankSequence: aString
"
non-blank-sequence → anything, provided it doesn’t contain special characters such as '-', nl, ''' and of course ' '
"
stream nextPutAll: aString
"Created: / 11-07-2017 / 21:54:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
printOption: aString
"
option → '-' parameter [ ' ' parameter ]
"
| i |
i := 1.
[ i <= aString size and:[ (aString at: i) == $- ] ] whileTrue:[
i := i + 1.
].
i to: aString size do:[:i |
| c |
c := aString at: i.
(self needCEscaping: c) ifTrue:[
self printParameter: aString.
^ self
].
].
stream nextPutAll: aString.
"Created: / 11-07-2017 / 21:51:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 11-07-2017 / 23:21:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
printParameter: aString
"
parameter → non-blank-sequence | c-string
"
(self isNonBlankSequence: aString) ifTrue:[
self printNonBlankSequence: aString
] ifFalse:[
self printCString: aString
].
"Created: / 11-07-2017 / 21:52:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!GDBMIPrinter methodsFor:'testing'!
isNonBlankSequence: aString
^ aString allSatisfy:[:each | (self needCEscaping: each) not ].
"Created: / 11-07-2017 / 21:53:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 11-07-2017 / 23:26:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
needCEscaping: aCharacter
^ aCharacter == $\
or:[ aCharacter == $"
or:[ (aCharacter codePoint between: 33 and: 16r7F) not ]]
"Created: / 11-07-2017 / 22:42:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !