Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
C
clean-test
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
1
Issues
1
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
clean-and-itasks
clean-test
Commits
f1531f18
Commit
f1531f18
authored
May 14, 2018
by
Camil Staps
🚀
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Restructure
parent
182c6e7a
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
3 additions
and
306 deletions
+3
-306
.gitignore
.gitignore
+3
-3
Makefile
Makefile
+0
-0
Tools/Cloogle
Tools/Cloogle
+0
-1
Tools/makecleantest.icl
Tools/makecleantest.icl
+0
-302
cleantest.icl
cleantest.icl
+0
-0
No files found.
.gitignore
View file @
f1531f18
Clean System Files/
Tools/
clean-compiler/
Tools/
cleantest
Tools/
makecleantest
clean-compiler/
cleantest
makecleantest
Tools/
Makefile
→
Makefile
View file @
f1531f18
File moved
Cloogle
@
6987d49d
Subproject commit 6987d49de50bdef8d5ec4e3df04a90210d88903d
Tools/makecleantest.icl
deleted
100644 → 0
View file @
182c6e7a
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
$,
mapSt
,
on
,
`
on`
,
seqSt
import
Data
.
Functor
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
import
System
.
Process
import
Text
import
CloogleDBFactory
import
Doc
import
TypeUtil
::
Options
=
{
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
}
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
#
(
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
#
(
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
optionDescription
::
Option
Options
optionDescription
=
WithHelp
True
$
Options
[
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
]})
"OPT"
"Add OPT to the print options (see Gast's PrintOption type)"
,
Shorthand
"-T"
"--test-option"
$
Option
"--test-option"
(\
po
opts
->
Ok
{
opts
&
test_options
=
opts
.
test_options
++
[
po
]})
"OPT"
"Add OPT to the test options (see Gast's Testoption type)"
,
Shorthand
"-c"
"--compile"
$
Flag
"--compile"
(\
opts
->
Ok
{
opts
&
compile
=
True
})
"Compile the tests after generation"
,
Shorthand
"-C"
"--clm-arg"
$
Option
"--clm-arg"
(\
arg
opts
->
Ok
{
opts
&
clm_args
=
opts
.
clm_args
++
[
arg
]})
"ARG"
"Add ARG to the command line arguments for clm"
,
Shorthand
"-r"
"--run"
$
Flag
"--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
#
(
ex
,
w
)
=
fileExists
fp
w
|
ex
=
(
Ok
(),
w
)
#
(
base
,_)
=
splitFileName
fp
#
(
err
,
w
)
=
assertDirectory
base
w
|
isError
err
=
(
err
,
w
)
=
createDirectory
fp
w
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
bootstrap
=
case
me
.
me_documentation
of
Just
d
->
fromMaybe
""
$
docPropertyBootstrap
d
Nothing
->
""
start
=
join
"
\n\t
"
[
"Start w = exposeProperties"
,
"["
+++
join
","
print_options
+++
"]"
,
"["
+++
join
","
test_options
+++
"]"
,
"[ EP "
+++
join
"
\n\t
, EP "
[
gp
.
gp_name
\\
gp
<-
props
]
,
"] w"
]
::
GeneratedProperty
=
{
gp_name
::
!
String
,
gp_implementation
::
!
String
}
generateProperties
::
![
PropertyVarInstantiation
]
!
FunctionEntry
->
[
GeneratedProperty
]
generateProperties
pvis
fe
=:{
fe_documentation
=
Just
doc
}
=
[
gen
i
p
config
\\
p
<-
doc
.
properties
,
config
<-
configurations
$
groupInstantiations
$
pvis
++
docPropertyTestWith
doc
&
i
<-
[
1
..]]
where
groupInstantiations
::
[
PropertyVarInstantiation
]
->
[[(
String
,
Type
)]]
groupInstantiations
pvis
=
groupBy
((==)
`
on`
fst
)
$
sortBy
((<)
`
on`
fst
)
[
vi
\\
PropertyVarInstantiation
vi
<-
pvis
]
configurations
::
[[(
String
,
Type
)]]
->
[[(
String
,
Type
)]]
configurations
[
vis
:
viss
]
=
[[
vi`
:
vis`
]
\\
vi`
<-
vis
,
vis`
<-
configurations
viss
]
configurations
[]
=
[[]]
gen
::
!
Int
!
Property
![(
String
,
Type
)]
->
GeneratedProperty
gen
i
(
ForAll
name
ts
imp
)
vis
=
{
gp_name
=
name`
,
gp_implementation
=
join
"
\n
"
[
name`
+++
" :: "
+++
toString
type
,
join
" "
[
name`
:
map
fst
ts
]
+++
" = "
+++
imp
]
}
where
name`
=
if
(
i
==
1
)
name
(
name
+++
"_"
+++
toString
i
)
type
=
fromJust
$
assignAll
vis
$
Func
(
map
snd
ts
)
(
Type
"Property"
[])
[]
generateProperties
_
_
=
[]
Tools/
cleantest.icl
→
cleantest.icl
View file @
f1531f18
File moved
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment