1-- Copyright (C) 2010-2012 John Millikin <john@john-millikin.com> 2-- 3-- Licensed under the Apache License, Version 2.0 (the "License"); 4-- you may not use this file except in compliance with the License. 5-- You may obtain a copy of the License at 6-- 7-- http://www.apache.org/licenses/LICENSE-2.0 8-- 9-- Unless required by applicable law or agreed to in writing, software 10-- distributed under the License is distributed on an "AS IS" BASIS, 11-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12-- See the License for the specific language governing permissions and 13-- limitations under the License. 14 15module DBusTests.ObjectPath (test_ObjectPath) where 16 17import Data.List (intercalate) 18import Test.QuickCheck 19import Test.Tasty 20import Test.Tasty.HUnit 21import Test.Tasty.QuickCheck 22 23import DBus 24 25test_ObjectPath :: TestTree 26test_ObjectPath = testGroup "ObjectPath" 27 [ test_Parse 28 , test_ParseInvalid 29 ] 30 31test_Parse :: TestTree 32test_Parse = testProperty "parse" prop where 33 prop = forAll gen_ObjectPath check 34 check x = case parseObjectPath x of 35 Nothing -> False 36 Just parsed -> formatObjectPath parsed == x 37 38test_ParseInvalid :: TestTree 39test_ParseInvalid = testCase "parse-invalid" $ do 40 -- empty 41 Nothing @=? parseObjectPath "" 42 43 -- bad char 44 Nothing @=? parseObjectPath "/f!oo" 45 46 -- ends with a slash 47 Nothing @=? parseObjectPath "/foo/" 48 49 -- empty element 50 Nothing @=? parseObjectPath "/foo//bar" 51 52 -- trailing chars 53 Nothing @=? parseObjectPath "/foo!" 54 55gen_ObjectPath :: Gen String 56gen_ObjectPath = gen where 57 chars = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_" 58 59 gen = do 60 xs <- listOf (listOf1 (elements chars)) 61 return ("/" ++ intercalate "/" xs) 62 63instance Arbitrary ObjectPath where 64 arbitrary = fmap objectPath_ gen_ObjectPath 65