" (C) 2012 by Holger Hans Peter Freyther All Rights Reserved This program is free software: you can redistribute it and/or modify it under the terms of the GNU Affero General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more details. You should have received a copy of the GNU Affero General Public License along with this program. If not, see . " TestCase subclass: SiteManagerTest [ testOMLAttributes [ self deny: SiteManagerOML omlAttributes isEmpty ] testOMLProcedures [ self deny: SiteManagerOML omlProcedures isEmpty ] testSiteManager [ | site | site := SiteManagerOML new. self deny: (site bts basebandTransceiver channel: 1) isNil ] testFOMAddress [ | sm | sm := SiteManagerOML new. self assert: sm fomInstance bts = 16rFF; assert: sm fomInstance trx = 16rFF; assert: sm fomInstance ts = 16rFF. ] ] TestCase subclass: BTSOMLTest [ testFOMAddress [ | sm | sm := SiteManagerOML new. self assert: sm bts fomInstance bts = 16r0; assert: sm bts fomInstance trx = 16rFF; assert: sm bts fomInstance ts = 16rFF. ] ] TestCase subclass: RadioCarrierOMLTest [ testFOMAddress [ | sm fom | sm := SiteManagerOML new. fom := sm bts radioCarrier fomInstance. self assert: fom bts = 16r0; assert: fom trx = 16r0; assert: fom ts = 16rFF. ] ] TestCase subclass: BasebandTransceiverOMLTest [ fomState [ ^ #(16r80 16r80 16r00 16r0D 16r61 16r04 16r00 16r00 16rFF 16r24 16r01 16r07 16r00 16r01 16r07 16r04 16r01) ] testFOMAddress [ | sm fom | sm := SiteManagerOML new. fom := sm bts basebandTransceiver fomInstance. self assert: fom bts = 16r0; assert: fom trx = 16r0; assert: fom ts = 16rFF. ] testStateChange [ | sm fom oml | sm := SiteManagerOML new. oml := ((sm bts basebandTransceiver) initializeAttributes; createStateChange) toMessage asByteArray. self assert: oml = self fomState asByteArray. ] ] TestCase subclass: RadioChannelOMLTest [ testFOMAddress [ | sm fom | sm := SiteManagerOML new. fom := (sm bts basebandTransceiver channel: 4) fomInstance. self assert: fom bts = 16r0; assert: fom trx = 16r0; assert: fom ts = 16r3. ] testChannelNumber [ | sm pchan lchan nr | "Create the channel" sm := SiteManagerOML new. pchan := sm bts basebandTransceiver channel: 2. pchan createChanSDCCH. lchan := pchan lchan: 3. "Now verify the radio channel. Counting starts at 0 there." nr := lchan channelNumber. self assert: nr isSdcch8Acch; assert: nr subslotNumber = 2; assert: nr timeslotNumber = 1. ] ] TestCase subclass: RoundTripTestCase [ parseClass [ ^ self subclassResponsibility ] convertForClassTest: aMsg [ ^ self subclassResponsibility ] roundtripTestFor: aSymbol class: aClass [ | msg data want | msg := self parseClass parse: (self perform: aSymbol) readStream. self assert: (self convertForClassTest: msg) = aClass. data := msg toMessage asByteArray. want := (self perform: aSymbol) asByteArray. data = want ifFalse: [ want printNl. data printNl. self assert: false. ]. ] ] RoundTripTestCase subclass: OMLMsgTest [ parseClass [ ^ OMLMessageBase ] convertForClassTest: aMsg [ ^ aMsg omDataField class ] fomData [ ^ #(16r80 16r80 16r00 16r0B 16r61 16r00 16rFF 16rFF 16rFF 16r24 16r01 16r07 16r00 16r01 16r07) ] swActReqData [ ^ #(16r80 16r80 16r00 16r1E 16r0A 16r00 16rFF 16rFF 16rFF 16r16 16r00 16r06 16r01 16r02 16r03 16r04 16r05 16r06 16r41 16r00 16r0D 16r42 16r12 16r00 16r03 16r01 16r02 16r03 16r13 16r00 16r03 16r03 16r04 16r05) ] swActReqAckData [ ^ #(128 128 0 30 11 0 255 255 255 22 0 6 1 2 3 4 5 6 65 0 13 66 18 0 3 1 2 3 19 0 3 3 4 5) ] activationRequestData [ ^ #(128 128 0 18 13 0 255 255 255 66 18 0 3 1 2 3 19 0 3 3 4 5) ] activationRequestDataAck [ ^ #(128 128 0 18 14 0 255 255 255 66 18 0 3 1 2 3 19 0 3 3 4 5) ] opStartData [ ^ #(128 128 0 5 116 0 255 255 255) ] setBtsAttributesData [ ^ #(128 128 0 61 65 1 0 255 255 25 85 91 97 103 109 115 24 6 14 0 2 1 16 51 30 36 36 168 52 33 168 31 63 37 0 1 10 12 10 11 1 42 10 43 3 232 10 128 35 10 8 3 41 9 63 153 0 7 0 241 16 0 1 0 0) ] adminStateUnlockData [ ^ #(128 128 0 7 105 1 0 255 255 4 2) ] setRadioCarrierAttributesData [ ^ #(128 128 0 12 68 2 0 0 255 45 10 5 0 2 3 41 ) ] ipaRslConnectData [ ^ #(16 128 0 10 13 99 111 109 46 105 112 97 99 99 101 115 115 0 224 4 0 0 255 133 0 129 11 187) ] setChannelAttributesData [ ^ #(128 128 0 9 71 3 0 0 0 13 5 64 7) ] testFomMessage [ | oml | oml := FOMMessage new omDataField: ( OMLStateChangedEventReport new objectClass: FOMMessage objectClassSiteManager; objectInstance: (FOMObjectInstance new bts: 16rFF trx: 16rFF ts: 16rFF; yourself); operationalState: OMLOperationalState disabledState; availabilityStatus: OMLAvailabilityStatus notInstalledState; yourself); yourself. self assert: oml toMessage asByteArray = self fomData asByteArray. ] testSWActivateRequest [ | oml | oml := FOMMessage new omDataField: ( OMLSWActivateRequest new objectClass: FOMMessage objectClassSiteManager; objectInstance: (FOMObjectInstance new bts: 16rFF trx: 16rFF ts: 16rFF; yourself); hwConfiguration: #(1 2 3 4 5 6); swConfiguration: ( OMLSWConfiguration new add: (OMLSWDescription new fileId: #(1 2 3); fileVersion: #(3 4 5); yourself); yourself); yourself); yourself. self assert: oml toMessage asByteArray = self swActReqData asByteArray ] testSWActivateRequestAckParsing [ | oml | oml := OMLMessageBase parse: self swActReqAckData readStream. ] testActivationRequest [ | oml data | oml := OMLMessageBase parse: self activationRequestData readStream. data := oml toMessage asByteArray. self assert: self activationRequestData asByteArray = data ] testActivationRequest [ | oml nack | oml := OMLMessageBase parse: self activationRequestData readStream. nack := oml createAck. self assert: nack toMessage asByteArray = self activationRequestDataAck asByteArray. ] testOpStart [ | oml | oml := OMLMessageBase parse: self opStartData readStream. self assert: self opStartData asByteArray = oml toMessage asByteArray ] testSetBTSAttributes [ | oml | oml := OMLMessageBase parse: self setBtsAttributesData readStream. self assert: oml omDataField class = OMLSetBTSAttributes. self assert: oml toMessage asByteArray = self setBtsAttributesData asByteArray. ] testAdmState [ self roundtripTestFor: #adminStateUnlockData class: OMLChangeAdminState. ] testSetRadioCarrierAttributes [ self roundtripTestFor: #setRadioCarrierAttributesData class: OMLSetRadioCarrierAttributes. ] testIpaRslConnect [ self roundtripTestFor: #ipaRslConnectData class: IPAOMLRSLConnect. ] testSetChannelAttributes [ self roundtripTestFor: #setChannelAttributesData class: OMLSetChannelAttributes. ] ] TestCase subclass: RSLSmokeTest [ testDiscriminatorsAreNumbers [ | ran | RSLMessageBase class methodDictionary keysAndValuesDo: [:key :value | (key startsWith: 'discriminator') ifTrue: [ ran := true. self assert: (RSLMessageBase perform: key) isNumber; assert: (RSLMessageBase perform: key) highBit <= 8. ] ]. self deny: ran isNil ] testMessageNamesAreNumbers [ | ran | RSLMessageBase class methodDictionary keysAndValuesDo: [:key :value | | handle | handle := (key startsWith: 'message') and: [(key startsWith: 'messageType') not]. handle ifTrue: [ ran := true. self assert: (RSLMessageBase perform: key) isNumber; assert: (RSLMessageBase perform: key) highBit <= 8. ] ]. self deny: ran isNil ] testAttributesAreNumbers [ | ran | RSLInformationElement class methodDictionary keysAndValuesDo: [:key :value | (key startsWith: 'attr') ifTrue: [ ran := true. self assert: (RSLInformationElement perform: key) isNumber; assert: (RSLInformationElement perform: key) highBit <= 8. ] ]. self deny: ran isNil ] testMessageDescriptions [ | ran | RSLMessageDefinitions class methodDictionary keysAndValuesDo: [:key :value | | res | (key endsWith: 'IE') ifFalse: [ ran := true. res := RSLMessageDefinitions perform: key. self assert: res class = OrderedCollection. res do: [:each | self assert: (each isKindOf: TLVDescription)]. ]. ]. self deny: ran isNil. ] testInstVarNames [ | ran | RSLMessageBase allSubclassesDo: [:each | (RSLMessageBase ignoredBaseClasses includes: each) ifFalse: [ each tlvDescription do: [:attr | ((each indexOfInstVar: attr instVarName) = 0) ifTrue: [^self error: 'InstVar %1 of %2 not available.' % {attr instVarName. each name.}]. ran := true. ] ] ]. self deny: ran isNil. ] ] RoundTripTestCase subclass: RSLRoundTripTest [ parseClass [ ^ RSLMessageBase ] convertForClassTest: aMsg [ ^ aMsg class ] bcchInformationData [ ^ #(12 17 1 128 30 1 39 23 85 6 25 143 148 128 0 0 0 0 0 0 0 0 0 0 0 0 0 229 4 0 43) ] sacchFillingData1 [ ^ #(16 26 30 5 11 0 19 73 6 29 143 148 128 0 0 0 0 0 0 0 0 0 0 0 0 0) ] sacchFillingData2 [ ^ #(16 26 30 6 11 0 12 45 6 30 0 0 0 241 16 0 1 39 255) ] channelActivationData [ ^ #(8 33 1 14 3 0 6 4 0 3 8 0 5 6 100 15 227 41 114 0 4 0 13 7 24 23) ] immediateAssignmentData [ ^ #(12 22 1 144 43 23 45 6 63 3 15 227 41 3 42 20 23 0 43 43 43 43 43 43 43 43 43 43 43) ] establishIndicationData [ ^ #(16r02 16r06 16r01 16r20 16r02 16r00 16r0B 16r00 16r0F 16r05 16r08 16r00 16r02 16rF8 16r01 16r74 16r05 16r30 16r05 16rF4 16rB5 16r0A 16rB9 16rBB) ] dataRequestData [ ^ #(16r03 16r01 16r01 16r20 16r02 16r00 16r0B 16r00 16r03 16r05 16r18 16r02) ] sacchDeactivateData [ ^ #(8 37 1 32) ] releaseRequestData [ ^ #(2 7 1 32 2 0 20 0) ] testBCCHInformation [ self roundtripTestFor: #bcchInformationData class: RSLBCCHInformation ] testSacchFilling [ self roundtripTestFor: #sacchFillingData1 class: RSLSACCHFilling. self roundtripTestFor: #sacchFillingData2 class: RSLSACCHFilling. ] testImmediateAssignment [ | rsl gsm | self roundtripTestFor: #immediateAssignmentData class: RSLImmediateAssignment. rsl := RSLMessageBase parse: self immediateAssignmentData readStream. gsm := OsmoGSM.GSM48MSG decode: (rsl fullL3Info readStream skip: 1; yourself). self assert: gsm requestReference ra = 3. ] testChannelActivation [ | rsl | self roundtripTestFor: #channelActivationData class: RSLChannelActivation. "Now do some analysis" rsl := RSLMessageBase parse: self channelActivationData readStream. "Some simple assertions on the channel number" self deny: rsl channelNumber isNil; assert: rsl channelNumber class = RSLChannelNumber; assert: rsl channelNumber timeslotNumber = 2r110; assert: rsl channelNumber cBits = 2r1; assert: rsl channelNumber isBmAcch; assert: rsl channelNumber subslotNumber = 0. ] testEstablishIndication [ self roundtripTestFor: #establishIndicationData class: RSLEstablishIndication. ] testDataRequest [ | rsl | self roundtripTestFor: #dataRequestData class: RSLDataRequest. rsl := RSLMessageBase parse: self dataRequestData readStream. self assert: rsl linkIdentifier data = #(0); assert: rsl channelNumber isSdcch4Acch; assert: rsl channelNumber subslotNumber = 0; assert: rsl channelNumber timeslotNumber = 0; assert: rsl l3Information data size = 3; assert: rsl l3Information data = #(16r05 16r18 16r02). ] testSacchDeactivate [ self roundtripTestFor: #sacchDeactivateData class: RSLSacchDeactivate. ] testReleaseRequestData [ self roundtripTestFor: #releaseRequestData class: RSLReleaseRequest. ] ] TestCase subclass: RSLIETest [ testRachTN [ self assert: RSLChannelNumber ccchRach timeslotNumber = 0; assert: RSLChannelNumber ccchRach isRacch; should: [RSLChannelNumber ccchRach subslotNumber] raise: Exception. ] ]