Permalink
Browse files

Tests now work.

  • Loading branch information...
1 parent 5e08cc0 commit 760f0f266273f6b10f64792a219bab01b2375afd @mitar committed Jan 14, 2012
Showing with 41 additions and 41 deletions.
  1. +13 −18 lib/Robotics/NXT/Protocol.hs
  2. +1 −0 src/UploadFiles.hs
  3. +27 −23 tests/Robotics/NXT/Basic.hs
View
31 lib/Robotics/NXT/Protocol.hs
@@ -101,6 +101,7 @@ module Robotics.NXT.Protocol (
execNXT
) where
+import qualified Data.ByteString as B
import Control.Exception
import Control.Monad.State
import Data.Bits
@@ -111,7 +112,7 @@ import Data.Ratio
import Data.Time.Clock.POSIX
import Data.Word
import System.IO
-import System.Hardware.Serialport hiding (One)
+import qualified System.Hardware.Serialport as S
#if (!defined(mingw32_HOST_OS) && !defined(windows_HOST_OS))
import System.Posix.Signals
#endif
@@ -149,7 +150,7 @@ initialize device = do
let signals = foldl (flip addSignal) emptySignalSet [virtualTimerExpired]
blockSignals signals
#endif
- h <- openSerial device defaultSerialSettings { commSpeed = CS115200, timeout = 1000 }
+ h <- S.openSerial device S.defaultSerialSettings { S.commSpeed = S.CS115200, S.timeout = 1000 }
#if (!defined(mingw32_HOST_OS) && !defined(windows_HOST_OS))
unblockSignals signals
#endif
@@ -164,7 +165,7 @@ terminate :: NXTInternals -> IO ()
terminate i = do
i' <- execNXT stopEverything i
let h = nxthandle i'
- closeSerial h
+ S.closeSerial h
when debug $ hPutStrLn stderr "terminated"
{-|
@@ -185,26 +186,20 @@ sendData message = do
h <- getsNXT nxthandle
let len = toUWord . length $ message
packet = len ++ message
- liftIO $ sendString h $ map (toEnum . fromEnum) packet
+ n <- liftIO . S.send h . B.pack $ packet
+ when (n /= length packet) $ liftIO $ failNXT' "not all data has been send"
when debug $ liftIO . hPutStrLn stderr $ "sent: " ++ show packet
-- Main function for receiving data from NXT
receiveData :: NXT [Word8]
receiveData = do
h <- getsNXT nxthandle
- let hChar :: IO Word8
- hChar = do
- c <- recvChar h
- case c of
- Just c' -> return $ toEnum . fromEnum $ c'
- Nothing -> throwIO TimoutException
- hGet :: Int -> IO [Word8]
- hGet l = replicateM l hChar
- len <- liftIO $ hGet 2
- let len' = fromUWord len
- packet <- liftIO $ hGet len'
- when debug $ liftIO . hPutStrLn stderr $ "received: " ++ show packet
- return packet
+ len <- liftIO $ S.recv h 2
+ let len' = fromUWord . B.unpack $ len
+ packet <- liftIO $ S.recv h len'
+ let unpacket = B.unpack packet
+ when debug $ liftIO . hPutStrLn stderr $ "received: " ++ show unpacket
+ return unpacket
{-|
Gets firmware and protocol versions of the NXT brick.
@@ -675,7 +670,7 @@ keepAlive' confirm = do
when debug $ liftIO . hPutStrLn stderr $ "keepalive"
current <- liftIO getPOSIXTime
modifyNXT (\s -> s { lastkeepalive = Just current })
- let send = [0x00, 0x0D]
+ let send = [request confirm, 0x0D]
sendData send
if confirm
then do
View
1 src/UploadFiles.hs
@@ -67,6 +67,7 @@ uploadFiles args = do
h' <- openWrite filename (fromIntegral size)
mapM_ (write h') $ chunk 61 content
close h'
+ liftIO $ putStrLn "Done."
chunk _ [] = [[]]
chunk n xs = y1 : chunk n y2
where (y1, y2) = splitAt n xs
View
50 tests/Robotics/NXT/Basic.hs
@@ -50,9 +50,9 @@ testNXT ref t = do
testDeviceInfo :: IORef NXTInternals -> Test
testDeviceInfo ref = TestLabel "testDeviceInfo" $ TestCase $ do
(DeviceInfo name address _ _) <- testNXT ref getDeviceInfo
- assertBool "empty name" (not $ null name)
+ assertBool "name" (not . null $ name)
putStrLn $ "NXT Name: " ++ name
- assertBool "empty address" (not $ null address)
+ assertBool "address" (not . null $ address)
putStrLn $ "NXT Address: " ++ address
remoteProgramFilename :: String
@@ -115,42 +115,46 @@ testOutputState ref = TestLabel "testOutputState" $ TestCase $ do
liftIO $ assertBool "not successful waitfor" successful
OutputState outputPort outputPower outputMode regulationMode turnRatio runState tachoLimit tachoCount _ _ <- getOutputState A
liftIO $ do
- assertEqual "not A outputPort" A outputPort
- assertEqual "not 0 outputPower" 0 outputPower
- assertEqual "not outputMode" [MotorOn, Brake] outputMode
- assertEqual "not regulationMode" RegulationModeIdle regulationMode
- assertEqual "not 0 turnRatio" 0 turnRatio
- assertEqual "not runState" MotorRunStateRunning runState
- assertEqual "not 0 tachoLimit" 0 tachoLimit
- assertBool "not tachoCount ~ 1000" (tachoCount > 900 && tachoCount < 1100)
+ assertEqual "outputPort" A outputPort
+ assertEqual "outputPower" 0 outputPower
+ assertEqual "outputMode" [MotorOn, Brake] outputMode
+ assertEqual "regulationMode" RegulationModeIdle regulationMode
+ assertEqual "turnRatio" 0 turnRatio
+ assertEqual "runState" MotorRunStateRunning runState
+ assertEqual "tachoLimit" 0 tachoLimit
+ assertBool ("tachoCount !~ 1000: " ++ show tachoCount) (tachoCount > 700 && tachoCount < 1300)
testInputMode :: IORef NXTInternals -> Test
testInputMode ref = TestLabel "testInputMode" $ TestCase $ do
InputValue inputPort valid _ sensorType sensorMode _ normalizedADValue scaledValue _ <- testNXT ref $ do
setInputModeConfirm One Switch BooleanMode
getInputValues One
- assertEqual "not 1 inputPort" One inputPort
+ assertEqual "inputPort" One inputPort
assertBool "not valid" valid
- assertEqual "not sensorType" Switch sensorType
- assertEqual "not sensorMode" BooleanMode sensorMode
- assertBool "not in range normalizedADValue" (normalizedADValue >= 0 && normalizedADValue <= 1023)
- assertEqual "not 0 scaledValue" 0 scaledValue
+ assertEqual "sensorType" Switch sensorType
+ assertEqual "sensorMode" BooleanMode sensorMode
+ assertBool ("normalizedADValue not in range [0, 1023]: " ++ show normalizedADValue) (normalizedADValue >= 0 && normalizedADValue <= 1023)
+ assertEqual "scaledValue" 0 scaledValue
testUltrasonicSensor :: IORef NXTInternals -> Test
testUltrasonicSensor ref = TestLabel "testUltrasonicSensor" $ TestCase $ do
measurement <- testNXT ref $ do
usInit Two
version <- usGetVersion Two
- liftIO $ assertEqual "not V1.0 version" "V1.0" version
+ liftIO $ assertEqual "version" "V1.0" version
vendor <- usGetVendorID Two
- liftIO $ assertEqual "not LEGO vendor" "LEGO" vendor
+ liftIO $ assertEqual "vendor" "LEGO" vendor
device <- usGetDeviceID Two
- liftIO $ assertEqual "not Sonar device" "Sonar" device
+ liftIO $ assertEqual "device" "Sonar" device
units <- usGetMeasurementUnits Two
- liftIO $ assertEqual "not 10E-2m units" "10E-2m" units
- usSetMode Two SingleShot
+ liftIO $ assertEqual "units" "10E-2m" units
+ usSetMode Two ContinuousMeasurement
mode <- usGetMode Two
- liftIO $ assertEqual "not mode" SingleShot mode
- usGetMeasurement Two 0
+ liftIO $ assertEqual "mode" ContinuousMeasurement mode
+ usSetMode Two SingleShot
+ measurement <- usGetMeasurement Two 0
+ usSetMode Two Off
+ mode' <- usGetMode Two
+ liftIO $ assertEqual "mode" Off mode'
+ return measurement
putStrLn $ "Ultrasonic sensor measurement: " ++ (show measurement)
-

0 comments on commit 760f0f2

Please sign in to comment.