smalltalk
/
osmo-st-all
Archived
1
0
Fork 0

Merge commit 'ab3b8e23fdf2cf40847bdcc854e14207908d1391'

This commit is contained in:
Holger Hans Peter Freyther 2015-01-23 09:35:42 +01:00
commit ea1d89b8e8
5 changed files with 44 additions and 8 deletions

View File

@ -2093,8 +2093,8 @@ Osmo.TLVParserBase subclass: GSM48MSG [
].
].
Exception signal: 'No one handles: ', classType asString,
' and: ', messageType asString.
^self error: 'No one handles: ', classType asString,
' and: ', messageType asString.
]
GSM48MSG class >> parseFrom: aStream [
@ -2847,6 +2847,22 @@ GSM48CCMessage subclass: GSM48CCEmergencySetup [
]
]
GSM48CCMessage subclass: GSM48CCProgress [
<category: 'OsmoGSM'>
GSM48CCProgress class >> messageType [ ^self msgProgress ]
GSM48CCProgress class >> tlvDescription [
<category: 'parsing'>
^OrderedCollection new
add: GSMProgress asTLVDescription;
add: (GSMUserUser asTLVDescription
beOptional;
minSize: 1 maxSize: 129;
yourself);
yourself
]
]
GSM48RRMessage subclass: GSM48RRAssignmentComplete [
<category: 'OsmoGSM'>
@ -3177,6 +3193,7 @@ Eval [
GSM48CCReleaseCompl initialize.
GSM48CCStatus initialize.
GSM48CCEmergencySetup initialize.
GSM48CCProgress initialize.
GSM48RRAssignmentComplete initialize.
GSM48RRHandoverCommand initialize.

View File

@ -16,7 +16,7 @@
along with this program. If not, see <http://www.gnu.org/licenses/>.
"
Array extend [
ArrayedCollection extend [
decodeGSM7Bit [
<category: '*OsmoGSM-coding'>
^ (OsmoGSM at: #GSMDecoding) decode: self.
@ -69,6 +69,10 @@ can be subclassed to deal with specifics for USSD and other systems.'>
^ self handleBytes: bytes from: bits
]
GSMDecoding class >> expand: aByteArray [
^self convertToBytes: (self convertFromBytes: aByteArray)
]
GSMDecoding class >> handleBytes: bytes from: bits [
^ bytes asString
]

View File

@ -65,7 +65,7 @@ Object subclass: IEMessage [
].
].
^ Exception signal: 'Unsupported IE type: ', type asString.
^self error: 'Unsupported IE type: ', type asString.
]
IEMessage class >> decode: aStream with: aIEBase [

View File

@ -39,7 +39,7 @@ Object subclass: SCCPConnectionState [
SCCPConnectionState class >> on: aHandler [
<category: 'creation'>
^ super new
^(self basicNew)
initialize;
conManager: aHandler;
yourself
@ -463,7 +463,7 @@ deadlocks should not occur.'>
SCCPHandler class >> new [
<category: 'creation'>
^ super new initialize; yourself
^self basicNew initialize
]
initialize [

View File

@ -463,6 +463,14 @@ TestCase subclass: GSM48Test [
dec := GSM48MSG decode: inp readStream.
self assert: dec toMessage asByteArray = inp.
]
testCCProgress [
| dec inp |
inp := #[16r83 16r03 16r02 16rEA 16r81].
dec := GSM48MSG decode: inp readStream.
self assert: dec toMessage asByteArray = inp.
]
]
SCCPHandler subclass: TestSCCPHandler [
@ -850,9 +858,16 @@ TestCase subclass: GSMEncodingTest [
| wanted res |
wanted := 'Your remaining balance is:1704 min,expiring on:10-07-2010'.
res := #(16rD9 16r77 16r5D 16r0E 16r92 16r97 16rDB 16rE1 16rB4 16r3B 16rED 16r3E 16r83 16rC4 16r61 16r76 16rD8 16r3D 16r2E 16r83 16rD2 16r73 16r5D 16rEC 16r06 16rA3 16r81 16rDA 16r69 16r37 16rAB 16r8C 16r87 16rA7 16rE5 16r69 16rF7 16r19 16rF4 16r76 16rEB 16r62 16rB0 16r16 16rEC 16rD6 16r92 16rC1 16r62 16r30) asByteArray decodeGSM7Bit.
res := #[16rD9 16r77 16r5D 16r0E 16r92 16r97 16rDB 16rE1 16rB4 16r3B 16rED 16r3E 16r83 16rC4 16r61 16r76 16rD8 16r3D 16r2E 16r83 16rD2 16r73 16r5D 16rEC 16r06 16rA3 16r81 16rDA 16r69 16r37 16rAB 16r8C 16r87 16rA7 16rE5 16r69 16rF7 16r19 16rF4 16r76 16rEB 16r62 16rB0 16r16 16rEC 16rD6 16r92 16rC1 16r62 16r30] decodeGSM7Bit.
self assert: res = wanted.
self assert: res equals: wanted.
]
testExpand [
| wanted res |
wanted := 'Your remaining balance is:1704 min,expiring on:10-07-2010' asByteArray.
res := GSMDecoding expand: #[217 119 93 14 146 151 219 225 180 59 237 62 131 196 97 118 216 61 46 131 210 115 93 236 6 163 129 218 105 55 171 140 135 167 229 105 247 25 244 118 235 98 176 22 236 214 146 193 98 48].
self assert: res equals: wanted
]
testUSSDEncode [