Skip to content

Instantly share code, notes, and snippets.

@marcmo marcmo/VoltageFFI.hs
Created Oct 10, 2012

Embed
What would you like to do?
using quickcheck to simulate voltage curves
#include "c_interface.h"
#include "voltage/VoltageManager.h"
#include "voltage/AbstractCriticalVoltageListener.h"
#include "TimeoutManagerMock.h"
#include <vector>
#include <iostream>
#include <algorithm>
using namespace power;
using namespace common;
using namespace mock;
using namespace std;
struct UnderVoltageListener : public AbstractUnderVoltageListener
{
UnderVoltageListener(ITimeoutManager2& tm, uint16 level, IVoltageListener::Battery b, uint32 debouncetime, uint16 hysteresis) :
AbstractUnderVoltageListener(tm, level,b,debouncetime),
fBattery(b),
fUnderVoltageOccuredCount(0),
fUnderVoltageLeftCount(0)
{
setHysteresis(hysteresis);
}
virtual ~UnderVoltageListener() {}
virtual void criticalVoltageEntered()
{
++fUnderVoltageOccuredCount;
}
virtual void criticalVoltageLeft()
{
++fUnderVoltageLeftCount;
}
IVoltageListener::Battery fBattery;
int fUnderVoltageOccuredCount;
int fUnderVoltageLeftCount;
};
int debounceTimeTest = 0;
class TestExecuter
{
public:
TestExecuter()
{
fpListeners = new ListenerList();
}
~TestExecuter()
{
remove_if(fpListeners->begin(),
fpListeners->end(),
[](UnderVoltageListener* x) -> bool { delete x; return true; });
delete fpListeners;
}
void addListener(int threshold, int debounceTime, int hysteresis)
{
UnderVoltageListener* x = new UnderVoltageListener(tmMock, threshold, IVoltageListener::BATTERY_L1, debounceTime, hysteresis);
fpListeners->push_back(x);
voltageManager.registerUnderVoltageListener(*x);
}
TimeoutManagerMock tmMock;
VoltageManager voltageManager;
typedef vector<UnderVoltageListener*> ListenerList;
ListenerList* fpListeners;
};
TestExecuter* pTestExecuter = 0L;
TestExecuter& getTestExecuter()
{
if (!pTestExecuter)
{
pTestExecuter = new TestExecuter();
}
return *pTestExecuter;
}
// implementation of FFI
void voltageEvent(int x)
{
getTestExecuter().voltageManager.voltageChanged(x, IVoltageListener::BATTERY_L1);
}
void timeoutEvent()
{
getTestExecuter().tmMock.alarmExpired();
}
int listenerVoltageState(int index)
{
return (*(getTestExecuter().fpListeners))[index]->getVoltageState();
}
int underVoltageOccuredCount(int index)
{
return (*(getTestExecuter().fpListeners))[index]->fUnderVoltageOccuredCount;
}
int underVoltageLeftCount(int index)
{
return (*(getTestExecuter().fpListeners))[index]->fUnderVoltageLeftCount;
}
void addListener(int threshold, int debounceTime, int hysteresis)
{
getTestExecuter().addListener(threshold, debounceTime, hysteresis);
}
void tearDownTestExecuter()
{
if (pTestExecuter)
{
pTestExecuter = 0L;
}
}
extern "C" void voltageEvent(int);
extern "C" void timeoutEvent();
extern "C" int listenerVoltageState(int);
extern "C" int underVoltageOccuredCount(int);
extern "C" int underVoltageLeftCount(int);
extern "C" void addListener(int, int, int);
extern "C" void tearDownTestExecuter();
void voltageEvent(int);
void timeoutEvent();
int listenerVoltageState(int);
int underVoltageOccuredCount(int);
int underVoltageLeftCount(int);
void addListener(int, int, int);
void tearDownTestExecuter();
{-# LANGUAGE ForeignFunctionInterface #-}
module VoltageFFI
(
voltageStateC
,addListenerC
,normal_voltage
,voltageChangeC
,c_timeoutEvent
,c_tearDown
)
where
import Foreign
import Foreign.C.Types
import System.IO
import VoltageTests
import Control.Applicative
normal_voltage=0 :: Int
under_voltage_pending=1 :: Int
under_voltage=2 :: Int
hysteresis_voltag=3 :: Int
foreign import ccall "ftest.h voltageEvent"
c_voltageEvent :: CInt -> IO ()
foreign import ccall "ftest.h timeoutEvent"
c_timeoutEvent :: IO ()
foreign import ccall "ftest.h listenerVoltageState"
c_voltageState :: CInt -> IO CInt
foreign import ccall "ftest.h underVoltageLeftCount"
c_underVoltageLeftCount :: CInt -> IO CInt
foreign import ccall "ftest.h underVoltageOccuredCount"
c_underVoltageCount :: CInt -> IO CInt
foreign import ccall "ftest.h addListener"
c_addListener :: CInt -> CInt -> CInt -> IO ()
foreign import ccall "ftest.h tearDownTestExecuter"
c_tearDown :: IO ()
voltageChangeC :: Int -> IO ()
voltageChangeC x = void $ c_voltageEvent (fromIntegral x)
voltageStateC :: Int -> IO (Int,Int,Int)
voltageStateC n = do
finalState <- fromIntegral <$> c_voltageState (fromIntegral n)
underVoltageCount <- fromIntegral <$> c_underVoltageCount (fromIntegral n)
underVoltageLeftCount <- fromIntegral <$> c_underVoltageLeftCount (fromIntegral n)
return (finalState,underVoltageCount,underVoltageLeftCount)
addListenerC :: VoltageListener -> IO ()
addListenerC (VL (a,b,c)) = c_addListener (fromIntegral a) (fromIntegral b) (fromIntegral c)
{-# LANGUAGE FlexibleInstances #-}
module VoltageTests where
import Test.QuickCheck
import Test.QuickCheck.Arbitrary
import Control.Applicative
import Data.List(foldl')
data VoltageListener = VL (Int,Int,Int) deriving (Eq,Ord,Show)
instance Arbitrary VoltageListener where
arbitrary = do
threshold <- choose (5000,10000)
debounce <- elements [0,100]
hyst <- elements [0,100..500]
return $ VL (threshold,debounce,hyst)
data Event = VoltageUpdate Int
| TimeoutEvent
| Register VoltageListener
| Deregister VoltageListener deriving(Eq,Ord)
instance Show Event where
show (VoltageUpdate x) = show x
show TimeoutEvent = "T"
show (Register x) = "register " ++ show x
show (Deregister x) = "deregister " ++ show x
instance Arbitrary Event where
arbitrary = frequency [(2,VoltageUpdate <$> choose(1,16000)),
(1,return TimeoutEvent)]
instance Arbitrary [Event] where
arbitrary = undefined
eventList :: Int -> Int -> (Int,Int) -> [Int] -> Gen [Event]
eventList n initial (a,b) r = do
nextUpdates <- vectorOf n $ frequency [(a,elements r), (b,elements (map negate r))]
let voltageUpdates = map VoltageUpdate $ reverse $ foldl' (\(prev:row) next->(prev+next):prev:row) [initial] nextUpdates
altList <- alternateList (2*n) (1,10) -- timeouts/VoltageUpdate = 1/10
return $ sprinkleTimeouts altList voltageUpdates
sprinkleTimeouts :: [Bool] -> [Event] -> [Event]
sprinkleTimeouts as es = reverse $ loop as es []
where loop (True:ass) xs res = loop ass xs (TimeoutEvent:res)
loop (False:ass) (x:xs) res = loop ass xs (x:res)
loop _ [] res = res
loop [] xs res = reverse xs ++ res
alternateList :: Int -> (Int,Int) -> Gen [Bool]
alternateList n (a,b) = vectorOf n $ frequency [(a,return True),(b,return False)]
data SlowRisingCurve = SlowRising [VoltageListener] [Event] deriving (Show)
instance Arbitrary SlowRisingCurve where
arbitrary = do
vs <- eventList 350 5000 (2,1) [100..150]
listener <- arbitrary
return $ SlowRising listener (cutAfter (>12500) vs)
data ErraticCurve = Erratic VoltageListener [Event] deriving (Show)
instance Arbitrary ErraticCurve where
arbitrary = do
vs <- vectorOf 150 arbitrary
listener <- arbitrary
return $ Erratic listener (vs ++ [VoltageUpdate 12000])
data RiseFallRiseCurve = RiseFallRise VoltageListener [Event] deriving (Show)
instance Arbitrary RiseFallRiseCurve where
arbitrary = do
vs <- eventList 130 5000 (2,1) [100..150]
vs2 <- eventList 100 (lastVoltage vs) (1,2) [100..150]-- declining
vs3 <- eventList 999 (lastVoltage vs2) (2,1) [100..150]
let vs3' = cutAfter (>13000) vs3
let vss = vs++vs2++vs3'
listener <- arbitrary
return $ RiseFallRise listener vss
where lastVoltage xs = v
where (VoltageUpdate v) = head $ filter isVoltageChange $ reverse xs
cutAfter :: (Int -> Bool) -> [Event] -> [Event]
cutAfter f xs = let (a,b) = break changeIsBeyond xs in
a ++ if null b then [] else [head b]
where changeIsBeyond (VoltageUpdate u) = f u
changeIsBeyond _ = False
cutBefore :: (Int -> Bool) -> [Event] -> [Event]
cutBefore f xs = fst $ break changeIsBeyond xs
where changeIsBeyond (VoltageUpdate u) = f u
changeIsBeyond _ = False
data AbruptDropsCurve = AbruptDrops VoltageListener [Event] deriving (Show)
instance Arbitrary AbruptDropsCurve where
arbitrary = do
nextUpdates <- vectorOf 200 $ frequency [(10,choose (-50,50)), (1,choose (-11000,0))]
let updates = foldl' (\row next->(12000+next):row) [] nextUpdates
let voltageUpdates = map VoltageUpdate $ reverse updates
altList <- alternateList 400 (1,10) -- timeouts/VoltageUpdate = 1/10
let vss = sprinkleTimeouts altList voltageUpdates
listener <- arbitrary
return $ AbruptDrops listener (VoltageUpdate 12000:vss)
shrink (AbruptDrops n (x:xs)) = map (AbruptDrops n . (x:)) (shrinkList shrink xs)
shrink a = [a]
data SlowlyDecliningCurve = SlowDecline VoltageListener [Event] deriving (Show)
instance Arbitrary SlowlyDecliningCurve where
arbitrary = do
vs <- eventList 400 12000 (1,2) [1..200]
listener <- arbitrary
return $ SlowDecline listener (cutBefore (<0) vs)
data VoltageCurve5 = VC5 VoltageListener [Event] deriving (Show)
instance Arbitrary VoltageCurve5 where
arbitrary = do
vs <- eventList 5000 1000 (2,1) [1..10]
let hyst = 100
let vss = takeWhile (voltageBelow (2000+hyst+1)) vs ++ [VoltageUpdate (2000+hyst+1)]
let listener = VL (2000,0,hyst)
return $ VC5 listener vss
shrink (VC5 _ (_:_:[])) = []
shrink (VC5 x xs) = map (VC5 x) (shrinkList shrink xs)
voltageBelow x (VoltageUpdate y) = y < x
voltageBelow _ TimeoutEvent = True
voltageBelow _ _ = False
displayVC5 = do
ss <- sample' arbitrary :: IO [VoltageCurve5]
mapM_ printInfo ss
printInfo (VC5 _ vs) = do
let fs = filter isVoltageChange vs
let fss = map getVolt fs
print fss
isVoltageChange (VoltageUpdate _) = True
isVoltageChange _ = False
getVolt (VoltageUpdate x) = x
getVolt x = error $ "no voltage for " ++ show x
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.