1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
-- Copyright (C) 2010-2012 John Millikin <john@john-millikin.com>
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
-- http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
module DBusTests.Signature (test_Signature) where
import Data.Maybe
import Test.QuickCheck
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import DBus
import DBusTests.Util
test_Signature :: TestTree
test_Signature = testGroup "Signature"
[ test_BuildSignature
, test_ParseSignature
, test_ParseInvalid
, test_FormatSignature
, test_IsAtom
, test_ShowType
]
test_BuildSignature :: TestTree
test_BuildSignature = testProperty "signature" prop where
prop = forAll gen_SignatureTypes check
check types = case signature types of
Nothing -> False
Just sig -> signatureTypes sig == types
test_ParseSignature :: TestTree
test_ParseSignature = testProperty "parseSignature" prop where
prop = forAll gen_SignatureString check
check (s, types) = case parseSignature s of
Nothing -> False
Just sig -> signatureTypes sig == types
test_ParseInvalid :: TestTree
test_ParseInvalid = testCase "parse-invalid" $ do
-- at most 255 characters
assertBool "valid parse failed" $
isJust (parseSignature (replicate 254 'y'))
assertBool "valid parse failed" $
isJust (parseSignature (replicate 255 'y'))
Nothing @=? parseSignature (replicate 256 'y')
-- length also enforced by 'signature'
assertBool "valid parse failed" $
isJust (signature (replicate 255 TypeWord8))
Nothing @=? signature (replicate 256 TypeWord8)
-- struct code
Nothing @=? parseSignature "r"
-- empty struct
Nothing @=? parseSignature "()"
Nothing @=? signature [TypeStructure []]
-- dict code
Nothing @=? parseSignature "e"
-- non-atomic dict key
Nothing @=? parseSignature "a{vy}"
Nothing @=? signature [TypeDictionary TypeVariant TypeVariant]
test_FormatSignature :: TestTree
test_FormatSignature = testProperty "formatSignature" prop where
prop = forAll gen_SignatureString check
check (s, _) = let
Just sig = parseSignature s
in formatSignature sig == s
test_IsAtom :: TestTree
test_IsAtom = testCase "IsAtom" $ do
let Just sig = signature []
assertAtom TypeSignature sig
test_ShowType :: TestTree
test_ShowType = testCase "show-type" $ do
"Bool" @=? show TypeBoolean
"Bool" @=? show TypeBoolean
"Word8" @=? show TypeWord8
"Word16" @=? show TypeWord16
"Word32" @=? show TypeWord32
"Word64" @=? show TypeWord64
"Int16" @=? show TypeInt16
"Int32" @=? show TypeInt32
"Int64" @=? show TypeInt64
"Double" @=? show TypeDouble
"UnixFd" @=? show TypeUnixFd
"String" @=? show TypeString
"Signature" @=? show TypeSignature
"ObjectPath" @=? show TypeObjectPath
"Variant" @=? show TypeVariant
"[Word8]" @=? show (TypeArray TypeWord8)
"Dict Word8 (Dict Word8 Word8)" @=? show (TypeDictionary TypeWord8 (TypeDictionary TypeWord8 TypeWord8))
"(Word8, Word16)" @=? show (TypeStructure [TypeWord8, TypeWord16])
gen_SignatureTypes :: Gen [Type]
gen_SignatureTypes = do
(_, ts) <- gen_SignatureString
return ts
gen_SignatureString :: Gen (String, [Type])
gen_SignatureString = gen where
anyType = oneof [atom, container]
atom = elements
[ ("b", TypeBoolean)
, ("y", TypeWord8)
, ("q", TypeWord16)
, ("u", TypeWord32)
, ("t", TypeWord64)
, ("n", TypeInt16)
, ("i", TypeInt32)
, ("x", TypeInt64)
, ("d", TypeDouble)
, ("h", TypeUnixFd)
, ("s", TypeString)
, ("o", TypeObjectPath)
, ("g", TypeSignature)
]
container = oneof
[ return ("v", TypeVariant)
, array
, dict
, struct
]
array = do
(tCode, tEnum) <- anyType
return ('a':tCode, TypeArray tEnum)
dict = do
(kCode, kEnum) <- atom
(vCode, vEnum) <- anyType
return (concat ["a{", kCode, vCode, "}"], TypeDictionary kEnum vEnum)
struct = do
ts <- listOf1 (halfSized anyType)
let (codes, enums) = unzip ts
return ("(" ++ concat codes ++ ")", TypeStructure enums)
gen = do
types <- listOf anyType
let (codes, enums) = unzip types
let chars = concat codes
if length chars > 255
then halfSized gen
else return (chars, enums)
instance Arbitrary Signature where
arbitrary = do
ts <- gen_SignatureTypes
let Just sig = signature ts
return sig
|
