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

sms: Fix the round-trip test for RP handling.

Fix the round-trip handling. This is still missing for message
types in other directions as this would require me writing test
cases first. I will get to that.
This commit is contained in:
Holger Hans Peter Freyther 2014-02-09 22:05:15 +01:00
parent 1dd46f82bb
commit e2372f67e8
2 changed files with 41 additions and 2 deletions

View File

@ -195,7 +195,6 @@ Object subclass: GSMRpInformationElement [
len printNl.
^self new
readFrom: (aStream next: len);
inspect;
yourself.
]
]
@ -212,6 +211,12 @@ GSMRpInformationElement subclass: GSMRpOrigantorAddress [
readFrom: anArray [
data := anArray
]
writeOn: aMessage with: anAttribute [
aMessage
putByte: data size;
putByteArray: data
]
]
GSMRpInformationElement subclass: GSMRpDestinationAddress [
@ -226,6 +231,12 @@ GSMRpInformationElement subclass: GSMRpDestinationAddress [
readFrom: anArray [
data := anArray
]
writeOn: aMessage with: anAttribute [
aMessage
putByte: data size;
putByteArray: data
]
]
GSMRpInformationElement subclass: GSMRpUserData [
@ -240,6 +251,12 @@ GSMRpInformationElement subclass: GSMRpUserData [
readFrom: anArray [
data := anArray
]
writeOn: aMessage with: anAttribute [
aMessage
putByte: data size;
putByteArray: data
]
]
Osmo.TLVParserBase subclass: GSMRpMessage [
@ -274,6 +291,13 @@ Osmo.TLVParserBase subclass: GSMRpMessage [
[self parseOptional: attr tag: aStream peek stream: aStream].
].
]
writeHeaderOn: aMessage [
direction = #msn
ifTrue: [aMessage putByte: self class messageTypeToNetwork]
ifFalse: [aMessage putByte: self class messageTypeToMS].
aMessage putByte: reference.
]
]
GSMRpMessage subclass: GSMRpData [
@ -281,6 +305,14 @@ GSMRpMessage subclass: GSMRpData [
<category: 'OsmoGSM-SMS-Message'>
<comment: '7.3.1'>
GSMRpData class >> messageTypeToNetwork [
^2r000
]
GSMRpData class >> messageTypeToMS [
^2r001
]
GSMRpData class >> tlvDescription [
^OrderedCollection new
add: GSMRpOrigantorAddress asTLVDescription;
@ -309,6 +341,10 @@ GSMRpMessage subclass: GSMRpAck [
add: GSMRpUserData asTLVDescription beOptional yourself;
yourself.
]
GSMRpAck class >> messageTypeToNetwork [
^2r010
]
]

View File

@ -35,7 +35,7 @@ TestCase subclass: GSM411Test [
assert: dec toMessage asByteArray = inp.
self
assert: dec rpMessage toMessage asByteArray = dec userData data.
assert: dec rpMessage toMessage asByteArray equals: dec userData data.
]
testCPData2 [
@ -46,5 +46,8 @@ TestCase subclass: GSM411Test [
self
assert: dec type = GSMCpData messageType;
assert: dec toMessage asByteArray = inp.
self
assert: dec rpMessage toMessage asByteArray equals: dec userData data.
]
]