From d52462c8114675e598f6d154bc33ba0a32ea45a3 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Tue, 20 Dec 2011 12:06:43 +0900 Subject: Using TH. --- Test.hs | 59 +++++++++++++++++++++++++---------------------------------- 1 file changed, 25 insertions(+), 34 deletions(-) diff --git a/Test.hs b/Test.hs index 4a9cdfe..a2a4f46 100644 --- a/Test.hs +++ b/Test.hs @@ -1,70 +1,64 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, TemplateHaskell #-} module Test where +import qualified Data.ByteString.Char8 as BS import Data.List import Network.DNS as DNS -import Test.Framework (defaultMain, testGroup, Test) import Test.Framework.Providers.HUnit -import Test.HUnit hiding (Test) -import qualified Data.ByteString.Char8 as BS +import Test.Framework.TH +import Test.HUnit -tests :: [Test] -tests = [ - testGroup "Test case" [ - testCase "lookupA" test_lookupA - , testCase "lookupAAAA" test_lookupAAAA - , testCase "lookupTXT" test_lookupTXT - , testCase "lookupAviaMX" test_lookupAviaMX - , testCase "lookupAviaCNAME" test_lookupAviaCNAME - , testCase "lookupPTR" test_lookupPTR - , testCase "lookupSRV" test_lookupSRV - ] - ] +---------------------------------------------------------------- + +main :: IO () +main = $(defaultMainGenerator) + +---------------------------------------------------------------- (?=) :: (Eq a, Show a) => IO a -> a -> IO () a ?= b = a >>= (@?= b) -test_lookupA :: IO () -test_lookupA = do +case_lookupA :: Assertion +case_lookupA = do rs <- makeResolvSeed defaultResolvConf withResolver rs $ \resolver -> DNS.lookupA resolver "www.mew.org" ?= Just ["202.232.15.101"] -(??=) :: (Ord a, Show a) => IO (Maybe [a]) -> [a] -> IO () +(??=) :: (Ord a, Show a) => IO (Maybe [a]) -> [a] -> Assertion a ??= bs = do mas <- a case mas of Nothing -> False @? "should be Nothing" Just as -> sort as @?= sort bs -test_lookupAAAA :: IO () -test_lookupAAAA = do +case_lookupAAAA :: Assertion +case_lookupAAAA = do rs <- makeResolvSeed defaultResolvConf withResolver rs $ \resolver -> do DNS.lookupAAAA resolver "mew.org" ?= Nothing DNS.lookupAAAA resolver "www.mew.org" ?= Just ["2001:240:11e:c00::101"] -test_lookupTXT :: IO () -test_lookupTXT = do +case_lookupTXT :: Assertion +case_lookupTXT = do rs <- makeResolvSeed defaultResolvConf withResolver rs $ \resolver -> DNS.lookupTXT resolver "mew.org" ?= Just ["v=spf1 +mx -all"] -test_lookupAviaMX :: IO () -test_lookupAviaMX = do +case_lookupAviaMX :: Assertion +case_lookupAviaMX = do rs <- makeResolvSeed defaultResolvConf withResolver rs $ \resolver -> DNS.lookupAviaMX resolver "mixi.jp" ??= ["202.32.29.4", "202.32.29.5"] -test_lookupAviaCNAME :: IO () -test_lookupAviaCNAME = do +case_lookupAviaCNAME :: Assertion +case_lookupAviaCNAME = do rs <- makeResolvSeed defaultResolvConf withResolver rs $ \resolver -> DNS.lookupA resolver "ghs.google.com" ??= ["72.14.203.121"] -test_lookupPTR :: IO () -test_lookupPTR = do +case_lookupPTR :: Assertion +case_lookupPTR = do rs <- makeResolvSeed defaultResolvConf withResolver rs $ \resolver -> DNS.lookupPTR resolver rev ?= Just ["www-v4.iij.ad.jp."] @@ -73,11 +67,8 @@ test_lookupPTR = do rev = BS.intercalate "." (reverse (BS.split '.' target)) `BS.append` ".in-addr.arpa" -test_lookupSRV :: IO () -test_lookupSRV = do +case_lookupSRV :: Assertion +case_lookupSRV = do rs <- makeResolvSeed defaultResolvConf withResolver rs $ \resolver -> DNS.lookupSRV resolver "_sip._tcp.cisco.com" ?= Just [(1,0,5060,"vcsgw.cisco.com.")] - -main :: IO () -main = defaultMain tests -- cgit v1.2.3