Commit 6835fbeb authored by Camil Staps's avatar Camil Staps 🚀

makecleantest: generate for directories

parent 694efe67
BIN:=cleantest makecleantest
CLM:=clm
CLMFLAGS:=-nr -nt -nortsopts\
CLMFLAGS:=-nr -nt -h 100m -nortsopts\
-IL ArgEnv\
-IL Platform\
-IL Platform/Deprecated/StdLib\
......
module makecleantest
import _SystemArray
import StdBool
import StdFile
from StdFunc import o
import StdOrdList
import StdString
import StdTuple
import Control.Monad => qualified join
import Data.Error
from Data.Func import $, on, `on`
from Data.Func import $, mapSt, on, `on`, seqSt
import Data.Functor
import Data.GenDefault
import Data.List
import Data.Maybe
import Data.Tuple
import System.CommandLine
import System.Directory
import System.Environment
import System.File
import System.FilePath
import System.Options
......@@ -26,71 +30,91 @@ import Doc
import TypeUtil
:: Options =
{ name :: !String
, input :: !FilePath
, output :: !FilePath
, print_options :: ![String]
, test_options :: ![String]
, compile :: !Bool
, clm_args :: ![String]
, run :: !Bool
{ directory :: !FilePath
, modules :: ![FilePath]
, output_directory :: !FilePath
, output_prefix :: !String
, includes :: ![FilePath]
, library_includes :: ![String]
, clean_home :: !FilePath
, print_options :: ![String]
, test_options :: ![String]
, compile :: !Bool
, clm_args :: ![String]
, run :: !Bool
, verbosity :: !Int
, color :: !Bool
}
gDefault{|Bool|} = False
derive gDefault Options
defaultOptions :: Options
defaultOptions =
{ directory = "."
, modules = []
, output_directory = "."
, output_prefix = "_Tests"
, includes = []
, library_includes = ["Gast","Platform"]
, clean_home = "/opt/clean"
, print_options = []
, test_options = []
, compile = False
, clm_args = []
, run = False
, verbosity = SUCCESS
, color = True
}
Start w
// Command line
# ([prog:args],w) = getCommandLine w
# opts = parseOptions optionDescription args gDefault{|*|}
| isError opts = exit (join "\n" $ fromError opts) w
# (clean_home,w) = appFst (fromMaybe "") $ getEnvironmentVariable "CLEAN_HOME" w
# opts = parseOptions optionDescription args {defaultOptions & clean_home=clean_home}
| isError opts = exit (join "\n" $ fromError opts) {defaultOptions & color=False} w
# opts = fromOk opts
| any ((==) "") [opts.Options.name, opts.input, opts.output]
= exit ("Usage: " +++ prog +++ " -n NAME -i FILE -o FILE") w
// Find properties
# (funs,macros,_,_,_,_,_,_,(_,mod,_),w) = findModuleContents False (dropExtension opts.input) w
# props = generatePropertyModule
opts.Options.name
opts.print_options
opts.test_options
mod
[f \\ (_,f,_) <- funs ++ macros]
// Write properties
# (dir,_) = splitFileName opts.output
# (ok,w) = assertDirectory dir w
| isError ok = exit (snd (fromError ok) <+ " " +++ opts.output) w
# (ok,w) = writeFile opts.output props w
| isError ok = exit (fromError ok <+ " " +++ opts.output) w
// Compile tests
| not opts.compile = w
# (ok,w) = callProcess "clm" (opts.clm_args ++ ["-nr",opts.Options.name,"-o",opts.Options.name]) Nothing w
| isError ok = exit (snd (fromError ok) <+ " during compilation") w
// Run tests
| not opts.run = w
# (ok,w) = callProcess ("." </> opts.Options.name) [] Nothing w
| isError ok = exit (snd (fromError ok) <+ " while running the tests") w
# (modules,w) = case opts.modules of
[_:_] -> (Ok [opts.Options.directory </> replaceSubString "." {pathSeparator} mod +++ ".dcl" \\ mod <- opts.modules], w)
[] -> findModules opts.Options.directory w
| isError modules = exit (snd (fromError modules) +++ " while finding modules") opts w
# w = seqSt (handleModule opts) (fromOk modules) w
= w
where
exit :: String *World -> *World
exit error w = snd $ fclose (stderr <<< error <<< "\n") $ setReturnCode 1 w
optionDescription :: Option Options
optionDescription = WithHelp True $ Options
[ Shorthand "-n" "--name" $ Option
"--name"
(\n opts -> Ok {Options | opts & name=n})
"NAME"
"The name for the test module"
, Shorthand "-i" "--input" $ Option
"--input"
(\f opts -> Ok {opts & input=f})
"FILE"
"The file name of a Clean module to generate tests for"
, Shorthand "-o" "--output" $ Option
"--output"
(\f opts -> Ok {opts & output=f})
"FILE"
"The file name to write the test to"
[ Shorthand "-d" "--directory" $ Option
"--directory"
(\dir opts -> Ok {Options | opts & directory=dir})
"DIR"
"The directory to test modules from (default: .)"
, Shorthand "-m" "--module" $ Option
"--module"
(\mod opts -> Ok {opts & modules=opts.modules ++ [mod]})
"MOD"
"Add MOD to the to-test modules -- when no modules are given, all modules from --directory are used"
, Shorthand "-D" "--output-directory" $ Option
"--output-directory"
(\dir opts -> Ok {opts & output_directory=dir})
"DIR"
"Use DIR as directory for test modules (default: .)"
, Shorthand "-p" "--prefix" $ Option
"--prefix"
(\p opts -> Ok {opts & output_prefix=p})
"PREFIX"
"The prefix for test module names (default: _Tests, i.e., Data.Set goes to _Tests.Data.Set)"
, Shorthand "-I" "--include" $ Option
"--include"
(\dir opts -> Ok {opts & includes=opts.includes ++ [dir]})
"DIR"
"Add DIR to the include path"
, Shorthand "-IL" "--include-library" $ Option
"--include-library"
(\lib opts -> Ok {opts & library_includes=opts.library_includes ++ [lib]})
"LIB"
"Add CLEAN_HOME/lib/LIB to the include path"
, Shorthand "-H" "--clean-home" $ Option
"--clean-home"
(\h opts -> Ok {opts & clean_home=h})
"PATH"
"Set CLEAN_HOME to PATH (used to find libraries)"
, Shorthand "-P" "--print-option" $ Option
"--print-option"
(\po opts -> Ok {opts & print_options=opts.print_options ++ [po]})
......@@ -114,8 +138,99 @@ where
"--run"
(\opts -> Ok {opts & compile=True, run=True})
"Run the tests after generation (implies --compile)"
, Shorthand "-v" "--verbose" $ Flag
"--verbose"
(\opts -> Ok {opts & verbosity=inc opts.verbosity})
"Increase verbosity (can be given multiple times)"
, Shorthand "-q" "--quiet" $ Flag
"--quiet"
(\opts -> Ok {opts & verbosity=dec opts.verbosity})
"Decrease verbosity (can be given multiple times)"
, Flag "--no-color"
(\opts -> Ok {opts & color=False})
"Turn off color in output"
]
exit :: !String !Options !*World -> *World
exit error opts w = setReturnCode 1 $ output ERROR error opts w
DEBUG :== 5
SUCCESS :== 4
INFO :== 3
WARNING :== 2
ERROR :== 1
output :: !Int !String !Options !*World -> *World
output level s opts w
| level > opts.verbosity = w
# (io,w) = stdio w
= snd $ fclose (io <<< color <<< s <<< newline) w
where
color
| opts.color = case level of
DEBUG -> "\033[0;36m"
INFO -> "\033[0;34m"
SUCCESS -> "\033[0;32m"
WARNING -> "\033[0;33m"
ERROR -> "\033[0;31m"
| otherwise = ""
newline = if opts.color "\033[0m\n" "\n"
findModules :: !FilePath !*World -> *(!MaybeOSError [FilePath], !*World)
findModules dir w
# (files,w) = readDirectory dir w
| isError files = (Error (fromError files), w)
= appFst (fmap flatten o sequence) $ mapSt recurse [fp \\ fp <- fromOk files | not $ isMember fp [".",".."]] w
where
recurse :: !FilePath !*World -> *(!MaybeOSError [FilePath], !*World)
recurse fp w
# fp = dir </> fp
# (info,w) = getFileInfo fp w
| isError info = (Error (fromError info), w)
| (fromOk info).FileInfo.directory = findModules fp w
| otherwise = (Ok (if (endsWith ".dcl" fp) [fp] []), w)
handleModule :: !Options !FilePath !*World -> *World
handleModule opts fp w
# w = output DEBUG ("Checking " +++ fp +++ "...") opts w
// Find properties
# (funs,macros,_,_,_,_,_,_,(modname,mod,_),w) = findModuleContents False (dropExtension fp) w
# output_modname = opts.output_prefix +++ "." +++ modname
# output_filename = opts.output_directory </> replaceSubString "." {pathSeparator} output_modname +++ ".icl"
# (nprops,props) = generatePropertyModule
output_modname
opts.print_options
opts.test_options
mod
[f \\ (_,f,_) <- funs ++ macros]
// Write properties
| nprops == 0 = w
# w = output INFO ("Found " <+ nprops <+ " test cases in module " +++ modname) opts w
# (dir,_) = splitFileName output_filename
# (ok,w) = assertDirectory dir w
| isError ok = exit (snd (fromError ok) <+ " " +++ output_filename) opts w
# (ok,w) = writeFile output_filename props w
| isError ok = exit (fromError ok <+ " " +++ output_filename) opts w
// Compile tests
| not opts.compile = w
# w = output INFO ("Compiling " +++ output_modname +++ "...") opts w
# output_exename = opts.output_directory </> output_modname
# (ok,w) = callProcess "clm"
(opts.clm_args ++
interleave "-I" [opts.Options.directory:opts.includes] ++
interleave "-IL" opts.library_includes ++
["-nr", output_modname, "-o", output_exename]) Nothing w
| isError ok = exit (snd (fromError ok) <+ " during compilation") opts w
| fromOk ok <> 0 = exit "Compilation finished with non-zero exit code" opts w
// Run tests
| not opts.run = w
# w = output INFO ("Running " +++ output_modname +++ "...") opts w
# (ok,w) = callProcess output_exename [] Nothing w
| isError ok = exit (snd (fromError ok) <+ " while running the tests") opts w
| fromOk ok <> 0 = exit "Test finished with non-zero exit code" opts w
= output SUCCESS (output_modname +++ " passed") opts w
where
assertDirectory :: !FilePath !*World -> *(!MaybeOSError (), !*World)
assertDirectory "" w = (Ok (), w)
assertDirectory fp w
......@@ -126,14 +241,18 @@ where
| isError err = (err, w)
= createDirectory fp w
generatePropertyModule :: !String ![String] ![String] !ModuleEntry ![FunctionEntry] -> String
generatePropertyModule name print_options test_options me fes = join "\n\n"
interleave :: a [a] -> [a]
interleave _ [] = []
interleave g [x:xs] = [g,x:interleave g xs]
generatePropertyModule :: !String ![String] ![String] !ModuleEntry ![FunctionEntry] -> (!Int, !String)
generatePropertyModule name print_options test_options me fes = (length props, join "\n\n"
[ "module " +++ name
, "import Gast, Gast.CommandLine"
, bootstrap
, start
: [gp.gp_implementation \\ gp <- props]
]
])
where
props = concatMap (generateProperties pvis) fes
where pvis = fromMaybe [] $ docPropertyTestWith <$> me.me_documentation
......
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