diff options
Diffstat (limited to 'external/semver/src/quickcheck')
-rw-r--r-- | external/semver/src/quickcheck/CMakeLists.txt | 29 | ||||
-rw-r--r-- | external/semver/src/quickcheck/Main.hi | bin | 0 -> 3353 bytes | |||
-rw-r--r-- | external/semver/src/quickcheck/Main.hs | 80 | ||||
-rw-r--r-- | external/semver/src/quickcheck/Main.o | bin | 0 -> 35952 bytes | |||
-rw-r--r-- | external/semver/src/quickcheck/Semver.hsc | 87 | ||||
-rw-r--r-- | external/semver/src/quickcheck/semantic_version_ffi.cpp | 58 | ||||
-rw-r--r-- | external/semver/src/quickcheck/semantic_version_ffi.h | 27 |
7 files changed, 281 insertions, 0 deletions
diff --git a/external/semver/src/quickcheck/CMakeLists.txt b/external/semver/src/quickcheck/CMakeLists.txt new file mode 100644 index 0000000..b8bb9b9 --- /dev/null +++ b/external/semver/src/quickcheck/CMakeLists.txt @@ -0,0 +1,29 @@ +find_program(HSC2HS hsc2hs) +find_program(GHC ghc) + +if (HSC2HS AND GHC) + + # the shared lib + add_library(${PROJECT_NAME}_ffi SHARED + ../lib/semantic_version_v1.cpp ../lib/semantic_version_v2.cpp semantic_version_ffi.cpp) + # the ffi bindings + add_custom_command( + OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/Semver.hs + MAIN_DEPENDENCY Semver.hsc + DEPENDS semantic_version_ffi.h + COMMAND ${HSC2HS} ${CMAKE_CURRENT_SOURCE_DIR}/Semver.hsc -I ${CMAKE_CURRENT_SOURCE_DIR} -o ${CMAKE_CURRENT_BINARY_DIR}/Semver.hs) + # the quickcheck executable + add_custom_command( + OUTPUT quickcheck_${PROJECT_NAME} + MAIN_DEPENDENCY Main.hs + DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/Semver.hs + DEPENDS ${PROJECT_NAME}_ffi + COMMAND ${GHC} --make ${CMAKE_CURRENT_SOURCE_DIR}/Main -L. -lsemver_ffi -o quickcheck_${PROJECT_NAME}) + add_custom_target(quickcheck ALL + DEPENDS quickcheck_${PROJECT_NAME}) + # pipe to ctest + add_test(NAME quickcheck_${PROJECT_NAME} + COMMAND ${CMAKE_CURRENT_BINARY_DIR}/quickcheck_${PROJECT_NAME}) + set_tests_properties(quickcheck_${PROJECT_NAME} PROPERTIES TIMEOUT 30 ENVIRONMENT "LD_LIBRARY_PATH=${CMAKE_CURRENT_BINARY_DIR}") + +endif() diff --git a/external/semver/src/quickcheck/Main.hi b/external/semver/src/quickcheck/Main.hi Binary files differnew file mode 100644 index 0000000..0739459 --- /dev/null +++ b/external/semver/src/quickcheck/Main.hi diff --git a/external/semver/src/quickcheck/Main.hs b/external/semver/src/quickcheck/Main.hs new file mode 100644 index 0000000..fc1d625 --- /dev/null +++ b/external/semver/src/quickcheck/Main.hs @@ -0,0 +1,80 @@ +module Main where + +import Semver +import Test.QuickCheck + +import System.Environment +import System.Console.GetOpt + +-- command line options +data Options = Options { optVerbose :: Bool + , optNumTests :: Int + } deriving Show + +defaultOptions :: Options +defaultOptions = Options { optVerbose = False + , optNumTests = 100 + } + +options :: [OptDescr (Options -> Options)] +options = + [ Option "v" ["verbose"] (NoArg (\opts -> opts { optVerbose = True })) + "run tests with verbose output" + + , Option "n" ["numtests"] (ReqArg + (\d opts -> opts { optNumTests = read d }) + "<num>") + "number of tests to run" + ] + +parseOpts :: [String] -> IO (Options, [String]) +parseOpts argv = + case getOpt Permute options argv of + (o, n, []) -> return (foldl (flip id) defaultOpts o, n) + where defaultOpts = defaultOptions + (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options)) + where header = "Usage: test [options]" + +-- generate arbitrary Senvers +instance Arbitrary Semver where + arbitrary = do + r1 <- arbitrary + r2 <- arbitrary + r3 <- arbitrary + return (Semver r1 r2 r3 "" "") + +-- properties +-- a version always satisfies itself +prop_satisfies :: Property +prop_satisfies = + property $ + \s -> satisfies s s + +-- a version is always less than its next {major, minor, patch} version +prop_lessThanNext :: (Semver -> Semver) -> Property +prop_lessThanNext f = + property $ + \s -> let s' = f s in s `lessThan` s' + +prop_lessThanNextMajor :: Property +prop_lessThanNextMajor = prop_lessThanNext nextMajor + +prop_lessThanNextMinor :: Property +prop_lessThanNextMinor = prop_lessThanNext nextMinor + +prop_lessThanNextPatch :: Property +prop_lessThanNextPatch = prop_lessThanNext nextPatch + +-- drive quickcheck +main :: IO () +main = do + args <- getArgs + (o, _) <- parseOpts args + let numCheck = quickCheckWith stdArgs { maxSuccess = optNumTests o } + checker = if optVerbose o + then numCheck . verbose + else numCheck + in do checker prop_satisfies + checker prop_lessThanNextMajor + checker prop_lessThanNextMinor + checker prop_lessThanNextPatch diff --git a/external/semver/src/quickcheck/Main.o b/external/semver/src/quickcheck/Main.o Binary files differnew file mode 100644 index 0000000..3775e7b --- /dev/null +++ b/external/semver/src/quickcheck/Main.o diff --git a/external/semver/src/quickcheck/Semver.hsc b/external/semver/src/quickcheck/Semver.hsc new file mode 100644 index 0000000..c96eb00 --- /dev/null +++ b/external/semver/src/quickcheck/Semver.hsc @@ -0,0 +1,87 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module Semver where + +#include "semantic_version_ffi.h" + +import Foreign hiding (unsafePerformIO) +import Foreign.C.String +import Foreign.Storable +import System.IO.Unsafe (unsafePerformIO) + +data Semver = Semver + { vMajor :: #{type unsigned int} + , vMinor :: #{type unsigned int} + , vPatch :: #{type unsigned int} + , vPrerelease :: String + , vBuild :: String + } deriving (Eq, Show) + +-- don't bother with the strings for now + +instance Storable Semver where + sizeOf _ = #{size semver_t} + alignment _ = alignment (undefined :: Word32) + + peek ptr = do + r1 <- #{peek semver_t, major} ptr + r2 <- #{peek semver_t, minor} ptr + r3 <- #{peek semver_t, patch} ptr + return (Semver r1 r2 r3 "" "") + + poke ptr (Semver r1 r2 r3 _ _) = do + #{poke semver_t, major} ptr r1 + #{poke semver_t, minor} ptr r2 + #{poke semver_t, patch} ptr r3 + +-- c functions + +foreign import ccall "semantic_version_ffi.h satisfies" + c_satisfies :: Ptr Semver -> Ptr Semver -> IO Int +foreign import ccall "semantic_version_ffi.h lessThan" + c_lessThan :: Ptr Semver -> Ptr Semver -> IO Int +foreign import ccall "semantic_version_ffi.h nextMajor" + c_nextMajor :: Ptr Semver -> Ptr Semver -> IO () +foreign import ccall "semantic_version_ffi.h nextMinor" + c_nextMinor :: Ptr Semver -> Ptr Semver -> IO () +foreign import ccall "semantic_version_ffi.h nextPatch" + c_nextPatch :: Ptr Semver -> Ptr Semver -> IO () + +-- haskell wrappers + +satisfies :: Semver -> Semver -> Bool +satisfies a b = + unsafePerformIO $ + alloca $ \a_ptr -> + alloca $ \b_ptr -> do + poke a_ptr a + poke b_ptr b + r <- c_satisfies a_ptr b_ptr + return $ if (r == 1) then True else False + +lessThan :: Semver -> Semver -> Bool +lessThan a b = + unsafePerformIO $ + alloca $ \a_ptr -> + alloca $ \b_ptr -> do + poke a_ptr a + poke b_ptr b + r <- c_lessThan a_ptr b_ptr + return $ if (r == 1) then True else False + +nextFunc :: (Ptr Semver -> Ptr Semver -> IO ()) -> Semver -> Semver +nextFunc f a = + unsafePerformIO $ + alloca $ \a_ptr -> + alloca $ \b_ptr -> do + poke a_ptr a + f a_ptr b_ptr + peek b_ptr + +nextMajor :: Semver -> Semver +nextMajor = nextFunc c_nextMajor + +nextMinor :: Semver -> Semver +nextMinor = nextFunc c_nextMinor + +nextPatch :: Semver -> Semver +nextPatch = nextFunc c_nextPatch diff --git a/external/semver/src/quickcheck/semantic_version_ffi.cpp b/external/semver/src/quickcheck/semantic_version_ffi.cpp new file mode 100644 index 0000000..3c7d8fc --- /dev/null +++ b/external/semver/src/quickcheck/semantic_version_ffi.cpp @@ -0,0 +1,58 @@ +#include "semantic_version_ffi.h" +#include "semantic_version.h" + +using namespace semver; + +//------------------------------------------------------------------------------ + +int satisfies(const semver_t* a, const semver_t* b) +{ + Version va(a->major, a->minor, a->patch, + a->prerelease, a->build); + + Version vb(b->major, b->minor, b->patch, + b->prerelease, b->build); + + return va.Satisfies(vb) ? 1 : 0; +} + +int lessThan(const semver_t* a, const semver_t* b) +{ + Version va(a->major, a->minor, a->patch, + a->prerelease, a->build); + + Version vb(b->major, b->minor, b->patch, + b->prerelease, b->build); + + return (va < vb) ? 1 : 0; +} + +void nextMajor(const semver_t* a, semver_t* b) +{ + Version va(a->major, a->minor, a->patch, + a->prerelease, a->build); + Version vb = va.NextMajorVersion(); + b->major = vb.GetMajorVersion(); + b->minor = vb.GetMinorVersion(); + b->patch = vb.GetPatchVersion(); +} + +void nextMinor(const semver_t* a, semver_t* b) +{ + Version va(a->major, a->minor, a->patch, + a->prerelease, a->build); + Version vb = va.NextMinorVersion(); + b->major = vb.GetMajorVersion(); + b->minor = vb.GetMinorVersion(); + b->patch = vb.GetPatchVersion(); +} + +void nextPatch(const semver_t* a, semver_t* b) +{ + Version va(a->major, a->minor, a->patch, + a->prerelease, a->build); + Version vb = va.NextPatchVersion(); + b->major = vb.GetMajorVersion(); + b->minor = vb.GetMinorVersion(); + b->patch = vb.GetPatchVersion(); +} diff --git a/external/semver/src/quickcheck/semantic_version_ffi.h b/external/semver/src/quickcheck/semantic_version_ffi.h new file mode 100644 index 0000000..5a734af --- /dev/null +++ b/external/semver/src/quickcheck/semantic_version_ffi.h @@ -0,0 +1,27 @@ +#pragma once + +// FFI for semantic version + +#ifdef __cplusplus +extern "C" +{ +#endif + +typedef struct Semver +{ + unsigned int major; + unsigned int minor; + unsigned int patch; + char prerelease[32]; + char build[32]; +} semver_t; + +int satisfies(const semver_t* a, const semver_t* b); +int lessThan(const semver_t* a, const semver_t* b); +void nextMajor(const semver_t* a, semver_t* b); +void nextMinor(const semver_t* a, semver_t* b); +void nextPatch(const semver_t* a, semver_t* b); + +#ifdef __cplusplus +} +#endif |