aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorHolger Hans Peter Freyther <zecke@selfish.org>2011-03-29 21:41:01 +0200
committerHolger Hans Peter Freyther <zecke@selfish.org>2011-03-29 21:41:01 +0200
commitb176bea4b53a2c056ad43e0fbbd54cd9c26ba43c (patch)
tree7867d9641c47a3a77312e010aae1acd7f53ab163
parentec1e5a94dbaee45a14c33f84e8a8446d378d9ea2 (diff)
ber: Move the tuple to constructed.. add X690 types I know
-rw-r--r--BERTLVStream.st44
-rw-r--r--BERTLVStreamTest.st6
2 files changed, 45 insertions, 5 deletions
diff --git a/BERTLVStream.st b/BERTLVStream.st
index ff15bc4..3aff0ef 100644
--- a/BERTLVStream.st
+++ b/BERTLVStream.st
@@ -60,6 +60,46 @@ Object subclass: BERTag [
yourself
]
+ BERTag class >> endOfContents [
+ <category: 'x690 types'>
+ ^ self fromTuple: #(0 false 0)
+ ]
+
+ BERTag class >> boolean [
+ <category: 'x690 types'>
+ ^ self fromTuple: #(0 false 1)
+ ]
+
+ BERTag class >> integer [
+ <category: 'x690 types'>
+ ^ self fromTuple: #(0 false 2)
+ ]
+
+ BERTag class >> octetString [
+ <category: 'x690 types'>
+ ^ self fromTuple: #(0 false 4)
+ ]
+
+ BERTag class >> null [
+ <category: 'x690 types'>
+ ^ self fromTuple: #(0 false 5)
+ ]
+
+ BERTag class >> enumerated [
+ <category: 'x690 types'>
+ ^ self fromTuple: #(0 false 10)
+ ]
+
+ BERTag class >> sequence [
+ <category: 'x690 types'>
+ ^ self fromTuple: #(0 true 16)
+ ]
+
+ BERTag class >> set [
+ <category: 'x690 types'>
+ ^ self fromTuple: #(0 true 17)
+ ]
+
initialize [
<category: 'init'>
classType := BERTag classUniversal.
@@ -92,7 +132,7 @@ Object subclass: BERTag [
<category: 'decoding'>
classType := aTuple first bitAnd: 16r3.
- constructed := aTuple second not.
+ constructed := aTuple second.
tagValue := aTuple third.
]
@@ -135,6 +175,6 @@ Object subclass: BERTag [
asTuple [
<category: 'conversion'>
- ^ Array with: self classType with: self isPrimitive with: self tagValue.
+ ^ Array with: self classType with: self isConstructed with: self tagValue.
]
]
diff --git a/BERTLVStreamTest.st b/BERTLVStreamTest.st
index 52b57dc..a274d8d 100644
--- a/BERTLVStreamTest.st
+++ b/BERTLVStreamTest.st
@@ -19,14 +19,14 @@
TestCase subclass: BERTagTest [
testSimpleTag [
<category: 'test'>
- self assert: (BERTag parseFrom: #(16rA1) asByteArray readStream) asTuple = #(2 false 1).
+ self assert: (BERTag parseFrom: #(16rA1) asByteArray readStream) asTuple = #(2 true 1).
]
testFromTuple [
| tuple |
<category: 'test'>
- tuple := #(2 false 1).
+ tuple := #(2 true 1).
self assert: (BERTag fromTuple: tuple) asTuple = tuple.
]
@@ -34,7 +34,7 @@ TestCase subclass: BERTagTest [
| tuple stream |
<category: 'test'>
- tuple := #(2 false 1).
+ tuple := #(2 true 1).
stream := WriteStream on: (ByteArray new: 1).
(BERTag fromTuple: tuple) writeOn: stream.