Verified Commit 15dd3631 authored by Camil Staps's avatar Camil Staps 🚀

Add Gast.CommandLine and example CLI test application

parent ca44bd49
definition module Gast.CommandLine
/**
* A wrapper around a set of Gast properties that handles options as defined in
* {{`Testing.Options`}}.
*/
from Gast.Testable import class Testable, :: Testoption
/**
* This class extends TestableWithOptions with a member to get Testoptions.
*/
class TestableWithOptions a | Testable a
where
getOptions :: a -> [Testoption]
/**
* The default implemenetation of TestableWithOptions is to have no options.
*/
instance TestableWithOptions a
instance Testable ([o], a) | Testable a
instance TestableWithOptions ([Testoption], a) | Testable a
/**
* Wrap a TestableWithOptions in an existential type to easily build
* quasi-heterogeneous lists of properties.
*/
:: ExposedProperty = E.p: EP p & TestableWithOptions p
instance Testable ExposedProperty
instance TestableWithOptions ExposedProperty
/**
* Expose a set of Gast properties as a CLI application.
*
* @param The default options for all tests.
* @param The tests to expose.
*/
exposeProperties :: ![Testoption] ![a] !*World -> *World | TestableWithOptions a
implementation module Gast.CommandLine
from StdFunc import flip, o
import StdList
import StdString
import StdTuple
import Data.Error
from Data.Func import $
import Data.List
import System.CommandLine
import System.Options
import Testing.Options
import Text
import Gast
instance TestableWithOptions a
where
getOptions _ = []
instance Testable ([o], a) | Testable a
where
evaluate (_,p) g a = evaluate p g a
testname (_,p) = testname p
instance TestableWithOptions ([Testoption], a) | Testable a
where
getOptions (opts,_) = opts
instance Testable ExposedProperty
where
evaluate (EP p) g a = evaluate p g a
testname (EP p) = testname p
instance TestableWithOptions ExposedProperty
where
getOptions (EP p) = getOptions p
exposeProperties :: ![Testoption] ![a] !*World -> *World | TestableWithOptions a
exposeProperties testopts ps w
# ([_:opts], w) = getCommandLine w
# opts = parseOptions testOptionDescription opts gDefault{|*|}
| isError opts = error (join "\n" $ fromError opts) w
# opts = fromOk opts
# (io,w) = stdio w
| opts.list
# io = foldl (<<<) io [testname p +++ "\n" \\ p <- ps]
# (_,w) = fclose io w
= w
# ps = case opts.runs of
[] -> ps
rs -> filter (\p -> isMember (testname p) runnames) ps
with runnames = [r.TestRun.name \\ r <- rs]
# ps = filter (\p -> not (isMember (testname p) opts.skip)) ps
# io = foldl (<<<) io $ concatMap test ps
# (_,w) = fclose io w
= w
where
test :: a -> [String] | TestableWithOptions a
test p = Test (getOptions p ++ testopts) p
error :: !String !*World -> *World
error s w
# io = stderr
# io = io <<< s <<< "\n"
# (_,w) = fclose io w
# w = setReturnCode 1 w
= w
module with_options
/**
* An example program using the Gast.CommandLine module to wrap a test
* collection in a CLI application.
* Compile this with -nr -nt. For usage details, see --help on the executable.
*
* The tests are taken from Peter Achten's StdSetTest in
* https://gitlab.science.ru.nl/peter88/FP_Example_Solutions/.
*/
import StdBool
from StdFunc import flip
import StdList
import StdString
from Data.Func import $
import Data.Generics.GenLexOrd
from Data.Set import :: Set, instance == (Set a)
import qualified Data.Set as S
import Gast
import Gast.CommandLine
Start w = exposeProperties [OutputTestEvents]
[ EP membership
, EP conversion_invariant
, EP length_correct
, EP subset_correct
, EP proper_subset_correct
, EP newSet_is_empty
, EP emptyset
]
w
:: Enum = A | B | C
derive ggen Enum
derive genShow Enum
derive gEq Enum
derive gLexOrd Enum
derive JSONEncode Enum
instance == Enum where == x y = x === y
instance < Enum where < x y = (x =?= y) === LT
derive bimap []
membership :: Enum [Enum] -> Property
membership x xs = 'S'.member x ('S'.fromList xs) <==> isMember x xs
conversion_invariant :: [Enum] -> Bool
conversion_invariant xs = xs` == 'S'.fromList ('S'.toList xs`)
where xs` = 'S'.fromList xs
length_correct :: [Enum] -> Bool
length_correct xs = 'S'.size ('S'.fromList xs) == length (removeDup xs)
subset_correct :: [Enum] [Enum] -> Property
subset_correct xs ys = 'S'.isSubsetOf ('S'.fromList xs) ('S'.fromList ys)
<==> all (flip isMember ys) xs
proper_subset_correct :: [Enum] [Enum] -> Property
proper_subset_correct xs ys = 'S'.isProperSubsetOf ('S'.fromList xs) ('S'.fromList ys)
<==> all (flip isMember ys) xs && not (all (flip isMember xs) ys)
newSet_is_empty :: Property
newSet_is_empty = name "newSet_is_empty" $ 'S'.null 'S'.newSet
emptyset :: [Enum] -> Property
emptyset xs =
('S'.size xs` == 0 <==> 'S'.null xs`) /\
(xs` == 'S'.newSet <==> 'S'.null xs`)
where xs` = 'S'.fromList xs
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment