serialport 0.4.5 → 0.4.6

raw patch · 5 files changed

+150/−21 lines, 5 filesdep +HUnitdep +serialportdep ~base

Dependencies added: HUnit, serialport

Dependency ranges changed: base

Files

• System/Hardware/Serialport/Posix.hsc +23/−13
• System/Hardware/Serialport/Types.hs +4/−4
• System/Hardware/Serialport/Windows.hs +1/−1
• serialport.cabal +12/−3
• tests/Tests.hs +110/−0

@@ -8,7 +8,7 @@ import System.Posix.Types import System.Posix.Terminal import System.Hardware.Serialport.Types-import Foreign+import Foreign (Ptr, castPtr, alloca, peek, with) import Foreign.C import GHC.IO.Handle import GHC.IO.Device@@ -16,6 +16,8 @@ import Data.Typeable import GHC.IO.Buffer import GHC.IO.Encoding+import Control.Monad (void)+import Data.Bits   data SerialPort = SerialPort {@@ -28,7 +30,7 @@ instance RawIO SerialPort where   read (SerialPort fd' _) ptr n = return . fromIntegral =<< fdReadBuf fd' ptr (fromIntegral n)   readNonBlocking _ _ _ = error "readNonBlocking not implemented"-  write (SerialPort fd' _) ptr n = fdWriteBuf fd' ptr (fromIntegral n) >> return ()+  write (SerialPort fd' _) ptr n = void (fdWriteBuf fd' ptr (fromIntegral n))   writeNonBlocking _ _ _ = error "writenonblocking not implemented"  @@ -76,16 +78,27 @@   return =<< setSerialSettings serial_port settings  +-- |Use specific encoding for an action and restore old encoding afterwards+withEncoding :: TextEncoding -> IO a -> IO a+#if MIN_VERSION_base(4,5,0)+withEncoding encoding fun = do+  cur_enc <- getForeignEncoding+  setForeignEncoding encoding+  result <- fun+  setForeignEncoding cur_enc+  return result+#else+withEncoding _ fun = fun+#endif++ -- |Receive bytes, given the maximum number recv :: SerialPort -> Int -> IO B.ByteString recv (SerialPort fd' _) n = do-  cur_enc <- getForeignEncoding-  setForeignEncoding char8-  result <- Ex.try $ fdRead fd' count :: IO (Either IOError (String, ByteCount))-  setForeignEncoding cur_enc-  return $ case result of-             Right (str, _) -> B.pack str-             Left _         -> B.empty+  result <- withEncoding char8 $ Ex.try $ fdRead fd' count :: IO (Either IOError (String, ByteCount))+  case result of+     Right (str, _) -> return $ B.pack str+     Left _         -> return B.empty   where     count = fromIntegral n @@ -95,10 +108,7 @@         -> B.ByteString         -> IO Int          -- ^ Number of bytes actually sent send (SerialPort fd' _ ) msg = do-  cur_enc <- getForeignEncoding-  setForeignEncoding char8-  ret <- fdWrite fd' (B.unpack msg)-  setForeignEncoding cur_enc+  ret <- withEncoding char8 (fdWrite fd' (B.unpack msg))   return $ fromIntegral ret  

@@ -17,12 +17,12 @@   | CS38400   | CS57600   | CS115200-  deriving (Show)+  deriving (Show, Eq, Bounded)  -data StopBits = One | Two-data Parity = Even | Odd | NoParity-data FlowControl = Software | NoFlowControl+data StopBits = One | Two deriving (Show, Eq, Bounded)+data Parity = Even | Odd | NoParity deriving (Show, Eq, Bounded)+data FlowControl = Software | NoFlowControl deriving (Show, Eq, Bounded)  data SerialPortSettings = SerialPortSettings {                       commSpeed    :: CommSpeed,   -- ^ baudrate

@@ -28,7 +28,7 @@ instance RawIO SerialPort where   read (SerialPort h _) ptr n = return . fromIntegral =<< win32_ReadFile h ptr (fromIntegral n) Nothing   readNonBlocking _ _ _ = error "readNonBlocking not implemented"-  write (SerialPort h _) ptr n = win32_WriteFile h ptr (fromIntegral n) Nothing >> return ()+  write (SerialPort h _) ptr n = void (win32_WriteFile h ptr (fromIntegral n) Nothing)   writeNonBlocking _ _ _ = error "writenonblocking not implemented"  

@@ -1,7 +1,7 @@ Name:           serialport-Version:        0.4.5-Cabal-Version:  >= 1.6-Build-Type:     Custom+Version:        0.4.6+Cabal-Version:  >= 1.8+Build-Type:     Simple license:        BSD3 license-file:   LICENSE copyright:      (c) 2009-2011 Joris Putcuyps@@ -30,3 +30,12 @@     Build-Depends:    Win32     Other-Modules:    System.Hardware.Serialport.Windows                       System.Win32.Comm++Test-Suite Tests+  type:               exitcode-stdio-1.0+  main-is:            Tests.hs+  hs-source-dirs:     tests+  build-depends:      base,+                      HUnit,+                      bytestring,+                      serialport

@@ -0,0 +1,110 @@+import System.Environment+import System.Hardware.Serialport+import System.IO+import qualified Data.ByteString.Char8 as B+import Test.HUnit+import System.Exit+import Control.Concurrent++++configureComm :: SerialPort -> CommSpeed -> IO ()+configureComm h cs = do+  let control_char = case cs of+        CS1200   -> "a"+        CS2400   -> "b"+        CS4800   -> "c"+        CS9600   -> "d"+        CS19200  -> "e"+        CS57600  -> "f"+        CS115200 -> "g"+        _        -> error "commSpeed not supported"+  send h $ B.pack control_char+  assertEqual "configure serial port" control_char . B.unpack =<< recv h 100++++sendRange :: SerialPort -> IO ()+sendRange s =+  mapM_ sendAndRecv ['\x00'..'\xff']+  where+    sendAndRecv :: Char -> IO ()+    sendAndRecv c = do+      send s $ B.pack [c]+      assertEqual "byte mismatch" [c] . B.unpack =<< recv s 1++++testSerialport :: CommSpeed -> String -> SerialPort -> Test+testSerialport cs test_port control = TestCase $ do+  configureComm control cs+  withSerial test_port defaultSerialSettings { commSpeed = cs } sendRange+  assertEqual "test ok" "ok\r\n" . B.unpack =<< recv control 100++++sendRangeH :: Handle -> IO ()+sendRangeH h =+  mapM_ sendAndRecv ['\x00'..'\xff']+  where+    sendAndRecv :: Char -> IO ()+    sendAndRecv c = do+      hPutChar h c+      assertEqual "byte mismatch" c =<< hGetChar h++++testHandle :: CommSpeed -> String -> SerialPort -> Test+testHandle cs test_port control = TestCase $ do+  configureComm control cs+  h <- hOpenSerial test_port defaultSerialSettings { commSpeed = cs }+  sendRangeH h+  hClose h+  assertEqual "test ok" "ok\r\n" . B.unpack =<< recv control 100+++testDelay :: String -> SerialPort -> Test+testDelay test_port control = TestCase $ do+  s <- openSerial test_port defaultSerialSettings { timeout = 6 }+  let control_char = 'h'+  send control $ B.pack [control_char]+  assertEqual "configure serial port" [control_char] . B.unpack =<< recv control 100++  send s $ B.pack "a"+  assertEqual "immediatly" "aA" . B.unpack =<< recv s 10++  send s $ B.pack "b"+  assertEqual "delay 50 ms" "bB" . B.unpack =<< recv s 10++  send s $ B.pack "c"+  assertEqual "delay 150 ms" "c" . B.unpack =<< recv s 10+  assertEqual "second try" "C" . B.unpack =<< recv s 10++  closeSerial s++++tests :: String -> SerialPort -> Test+tests test_port control = TestList $ map (\(descr,fun) -> TestLabel descr (fun test_port control)) testCases+  where+    testCases = [+      ("b1200 Serialport",  testSerialport CS1200),+      ("b2400 Serialport",  testSerialport CS2400),+      ("b4800 Serialport",  testSerialport CS4800),+      ("b9600 Serialport",  testSerialport CS9600),+      ("b19200 Serialport", testSerialport CS19200),+      ("b57600 Serialport", testSerialport CS57600),+      ("b115200 Serialport",testSerialport CS115200),+      ("b9600 Handle",      testHandle CS9600),+      ("test delay",        testDelay)+      ]+++main :: IO ExitCode+main = do+  [control_port, test_port] <- getArgs+  cnts <- withSerial control_port defaultSerialSettings (runTestTT . tests test_port)+  if failures cnts == 0+    then exitSuccess+    else exitFailure+