Start test suite

mitar · Jan 3, 2012 · 1850bb7 · 1850bb7
1 parent 0dd18f5
commit 1850bb7
Show file tree

Hide file tree

Showing 4 changed files with 183 additions and 76 deletions.
diff --git a/NXT.cabal b/NXT.cabal
@@ -1,84 +1,110 @@
-Name:                NXT
-Version:             0.1.8
-Synopsis:            A Haskell interface to Lego Mindstorms NXT
-Description:         A Haskell interface to Lego Mindstorms NXT over Bluetoooth. It supports direct commands, messages and
-                     many sensors (also unofficial). It has also support for a simple message-based control of a NXT brick
-                     via remotely executed program (basic NXC code included).
-                     .
-                     It contains two simple programs: @nxt-upload@ for uploading files to a NXT brick and @nxt-shutdown@ for
-                     remote shutdown of a NXT brick.
-                     .
-                     It works best on Linux and it also works on Mac OS X.
-                     .
-                     Feel free to contribute additional features, interfaces for more sensors and propose or write other
-                     (example) programs.
-License:             LGPL-3
-License-file:        LICENSE
-Author:              Mitar Milutinovic
-Maintainer:          mitar.haskell@tnode.com
-Copyright:           (c) 2010 Mitar Milutinovic
-Category:            Robotics
-Build-type:          Simple
-Cabal-version:       >= 1.8
-Stability:           experimental
-Homepage:            http://mitar.tnode.com
-Extra-source-files:  remote/remote.rxe,
-                     remote/remote.nxc,
-                     ffi/blue.h,
-                     ffi/initserial.h
-
-Library
-  Exposed-modules:     Robotics.NXT,
-                       Robotics.NXT.MotorControl,
-                       Robotics.NXT.Remote,
-                       Robotics.NXT.Sensor.Compass,
-                       Robotics.NXT.Sensor.Ultrasonic
-  Build-depends:       
-                       base >= 4.3 && < 5,
+name:                NXT
+version:             0.1.9
+synopsis:            A Haskell interface to Lego Mindstorms NXT
+description:         A Haskell interface to Lego Mindstorms NXT over Bluetoooth. It supports direct commands, messages and
+                     many sensors (also unofficial). It has also support for a simple message-based control of a NXT brick
+                     via remotely executed program (basic NXC code included).
+
+                     It contains two simple programs: @nxt-upload@ for uploading files to a NXT brick and @nxt-shutdown@ for
+                     remote shutdown of a NXT brick.
+
+                     It works best on Linux and it also works on Mac OS X.
+
+                     Feel free to contribute additional features, interfaces for more sensors and propose or write other
+                     (example) programs.
+license:             LGPL-3
+license-file:        LICENSE
+author:              Mitar Milutinovic
+maintainer:          mitar.haskell@tnode.com
+copyright:           (c) 2010 Mitar Milutinovic
+category:            Robotics
+build-type:          Simple
+cabal-version:       >= 1.8
+stability:           experimental
+homepage:            http://mitar.tnode.com
+extra-source-files:  remote/remote.rxe,
+                     remote/remote.nxc,
+                     ffi/blue.h,
+                     ffi/initserial.h
+
+library
+  exposed-modules:     Robotics.NXT,
+                       Robotics.NXT.MotorControl,
+                       Robotics.NXT.Remote,
+                       Robotics.NXT.Sensor.Compass,
+                       Robotics.NXT.Sensor.Ultrasonic
+  build-depends:       base >= 4.3 && < 5,
                        mtl >= 1.1 && < 3,
                        bytestring >= 0.9 && < 1,
                        time >= 1.1 && < 2,
                        serialport,
-                       transformers
-  if os(linux)
-    Build-depends:     unix >= 2.4 && < 3
-  Other-modules:       
-                       Robotics.NXT.Data,
+                       transformers
+  other-modules:       Robotics.NXT.Data,
                        Robotics.NXT.Errors,
                        Robotics.NXT.Protocol,
                        Robotics.NXT.Types,
                        Robotics.NXT.Internals,
                        Robotics.NXT.Externals,
                        Robotics.NXT.BluetoothUtils
-  HS-source-dirs:      lib
-  GHC-options:         -Wall
-  GHC-prof-options:    -Wall
-  GHC-shared-options:  -Wall
-  if os(linux)
-    C-sources:           ffi/blue.c,
-                         ffi/initserial.c
-    Includes:            ffi/blue.h,
-                         ffi/initserial.h
-    Extra-libraries:   bluetooth
-
-Source-repository head
-  type:                mercurial
-  location:            https://bitbucket.org/mitar/nxt
-
-Executable nxt-shutdown
-  Main-is:             Shutdown.hs
-  HS-source-dirs:      src
-  Build-depends:       base >= 4.3 && < 5,
-                       mtl >= 1.1 && < 3,
-                       NXT == 0.1.8
-  GHC-options:         -Wall
-
-Executable nxt-upload
-  Main-is:             UploadFiles.hs
-  HS-source-dirs:      src
-  Build-depends:       base >= 4.3 && < 5,
-                       mtl >= 1.1 && < 3,
-                       bytestring >= 0.9 && < 1,
-                       filepath >= 1.1 && < 2,
-                       NXT == 0.1.8
-  GHC-options:         -Wall
+  hs-source-dirs:      lib
+  ghc-options:         -Wall
+  ghc-prof-options:    -Wall
+  ghc-shared-options:  -Wall
+
+  if os(linux)
+    build-depends:  unix >= 2.4 && < 3
+
+  if os(linux)
+    c-sources:        ffi/blue.c,
+                         ffi/initserial.c
+    includes:         ffi/blue.h,
+                         ffi/initserial.h
+    extra-libraries:  bluetooth
+
+source-repository head
+  type:      mercurial
+  location:  https://bitbucket.org/mitar/nxt
+
+executable nxt-shutdown
+  main-is:         Shutdown.hs
+  hs-source-dirs:  src
+  build-depends:   
+                       base >= 4.3 && < 5,
+                       mtl >= 1.1 && < 3,
+                       NXT,
+                       transformers,
+                       serialport
+  ghc-options:     -Wall
+
+executable nxt-upload
+  main-is:         UploadFiles.hs
+  hs-source-dirs:  src
+  build-depends:   
+                       base >= 4.3 && < 5,
+                       mtl >= 1.1 && < 3,
+                       bytestring >= 0.9 && < 1,
+                       filepath >= 1.1 && < 2,
+                       NXT,
+                       transformers,
+                       serialport
+  ghc-options:     -Wall
+
+test-suite NXTTests
+  type:            exitcode-stdio-1.0
+  x-uses-tf:       true
+  build-depends:   
+                   base >= 4,
+                   HUnit >= 1.2 && < 2,
+                   QuickCheck >= 2.4,
+                   test-framework >= 0.4.1,
+                   test-framework-quickcheck2,
+                   test-framework-hunit,
+                   NXT,
+                   transformers,
+                   serialport,
+                   mtl
+  ghc-options:     -Wall -rtsopts
+  hs-source-dirs:  test
+  main-is:         Main.hs
+  other-modules:   Robotics.NXT.Basic
+
diff --git a/lib/Robotics/NXT/Protocol.hs b/lib/Robotics/NXT/Protocol.hs
@@ -113,7 +113,7 @@ import Data.Word
 --import Foreign.C.Error
 --import Foreign.C.Types
 import System.IO
-import System.Hardware.Serialport (openSerial,defaultSerialSettings,sendString ,recvChar,closeSerial,commSpeed ,timeout, CommSpeed(CS19200) )
+import System.Hardware.Serialport (openSerial,defaultSerialSettings,sendString ,recvChar,closeSerial,commSpeed ,timeout, CommSpeed(CS19200) , flush)
 --import System.Posix.Types
 import Text.Printf
 
@@ -143,7 +143,7 @@ defaultDevice :: FilePath
 defaultDevice = "/dev/rfcomm0"
 
 debug :: Bool
-debug = True
+debug = False
 
 {-|
 Opens and intializes a Bluetooth serial device communication.

diff --git a/test/Main.hs b/test/Main.hs
@@ -0,0 +1,40 @@
+
+module Main where
+
+import Robotics.NXT
+import Robotics.NXT.Basic
+
+import Control.Exception
+import Control.Monad.State.Class
+
+import Test.Framework (defaultMainWithArgs, testGroup,Test)
+import Test.Framework.Providers.HUnit
+
+
+import System.Environment ( getArgs)
+import Data.IORef
+import Control.Monad.IO.Class (liftIO)
+
+main :: IO()
+main = do
+  (device:args) <- getArgs
+  bracket (do
+                i<-initialize device
+                newIORef i)
+        (\ref->do
+                i'<-readIORef ref
+                terminate i')
+        (\ref->defaultMainWithArgs (tests ref) args)
+
+--  withNXT device (do
+--        i<-get
+--        ref<-liftIO $ newIORef i
+--        liftIO $ defaultMainWithArgs (tests ref) args
+--        i'<-liftIO $ readIORef ref
+--        return ()
+--        )
+
+tests :: IORef (NXTInternals) -> [Test]
+tests ref= [testGroup "Basic Tests" (concatMap hUnitTestToTests (basicTests ref))
+         ]
+
diff --git a/test/Robotics/NXT/Basic.hs b/test/Robotics/NXT/Basic.hs
@@ -0,0 +1,41 @@
+
+module Robotics.NXT.Basic where
+
+import Robotics.NXT
+import Test.HUnit
+
+import Control.Concurrent (threadDelay)
+import Data.IORef
+
+basicTests :: IORef NXTInternals -> [Test]
+basicTests d= map (\x->x d) [testDeviceInfo,testOutputState]
+--
+
+delay :: IO()
+delay =threadDelay $ 1000000 * 30
+
+testNXT :: IORef NXTInternals ->  NXT a -> IO a
+testNXT ref f=do
+        i<-readIORef ref
+        (a,i')<-runNXT f i
+        writeIORef ref i'
+        return a
+
+
+testDeviceInfo :: IORef NXTInternals -> Test
+testDeviceInfo ref= TestLabel "testDeviceInfo" (TestCase (do
+        (DeviceInfo name address _ _)<-testNXT ref getDeviceInfo
+        assertBool "empty name" (not $ null name)
+        putStrLn ("NXT Name: "++name)
+        assertBool "empty address" (not $ null address)
+        putStrLn ("NXT Address: "++address)
+        ))
+
+testOutputState :: IORef NXTInternals -> Test
+testOutputState ref= TestLabel "testOutputState" (TestCase (do
+       (OutputState port power modes reg ratio runstate limit count block rotation) <- testNXT ref (do
+                setOutputStateConfirm A 75 [MotorOn,Brake] RegulationModeMotorSpeed 0 MotorRunStateRunning 360
+                getOutputState A
+                )
+       assertEqual "not A port" A port
+       ))