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
2
Issues
2
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
9305beb3
Commit
9305beb3
authored
Feb 15, 2018
by
Camil Staps
🚀
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Start with
#1
: different output options
parent
b046320d
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
46 additions
and
24 deletions
+46
-24
Tools/CleanTest.icl
Tools/CleanTest.icl
+46
-24
No files found.
Tools/CleanTest.icl
View file @
9305beb3
...
...
@@ -22,12 +22,14 @@ import Text.JSON
import
Text
.
Language
::
Options
=
{
runs
::
![
Run
]
,
help
::
!
Bool
,
hide
::
![
MessageType
]
{
runs
::
![
Run
]
,
help
::
!
Bool
,
output
::
!
OutputFormat
,
hide
::
![
MessageType
]
}
::
MessageType
=
MT_Started
|
MT_Passed
|
MT_Failed
|
MT_Skipped
|
MT_Lost
::
OutputFormat
=
OF_JSON
|
OF_HumanReadable
messageType
::
TestEvent
->
MessageType
messageType
(
StartEvent
_)
=
MT_Started
...
...
@@ -45,7 +47,7 @@ derive gEq MessageType; instance == MessageType where == a b = a === b
}
gDefault
{|
Bool
|}
=
False
derive
gDefault
MessageType
,
Options
,
Run
derive
gDefault
MessageType
,
Options
,
OutputFormat
,
Run
::
ProcessOutput
=
{
lines
::
![
String
]
...
...
@@ -68,7 +70,7 @@ Start w
|
isError
opts
=
exit
True
(
Just
$
fromError
opts
)
prog
w
#
opts
=
fromOk
opts
|
opts
.
help
=
exit
True
Nothing
prog
w
#
w
=
seqSt
(
run
opts
.
hide
)
opts
.
runs
w
#
w
=
seqSt
(
run
opts
)
opts
.
runs
w
=
w
where
parseOpts
::
Options
[
String
]
->
MaybeErrorString
Options
...
...
@@ -77,7 +79,8 @@ where
=
parseOpts
opts
[
fromJust
(
'M'
.
get
arg
long_options
):
args
]
where
long_options
=
'M'
.
fromList
[
(
"-h"
,
"--help"
)
[
(
"-f"
,
"--output-format"
)
,
(
"-h"
,
"--help"
)
,
(
"-H"
,
"--hide"
)
,
(
"-n"
,
"--name"
)
,
(
"-O"
,
"--option"
)
...
...
@@ -103,6 +106,11 @@ where
[]
->
Error
"--option used before --run"
[
r
:
rs
]
->
parseOpts
{
opts
&
runs
=[{
r
&
options
=
r
.
options
++
[
opt
]}:
rs
]}
args
[]
->
Error
"--option requires a parameter"
parseOpts
opts
[
"--output-format"
:
args
]
=
case
args
of
[
"json"
:
args
]
->
parseOpts
{
opts
&
output
=
OF_JSON
}
args
[
"human"
:
args
]
->
parseOpts
{
opts
&
output
=
OF_HumanReadable
}
args
[
fmt
:
args
]
->
Error
$
"Unknown output format '"
+++
fmt
+++
"'"
[]
->
Error
"--output-format requires a parameter"
parseOpts
opts
[
"--name"
:
args
]
=
case
args
of
[
name
:
args
]
->
case
opts
.
runs
of
[]
->
Error
"-n used before -r"
...
...
@@ -123,20 +131,21 @@ where
where
help
::
String
help
=
prog
+++
": run Clean tests
\n
Options:
\n
"
+++
" --help/-h Show this help
\n
"
+++
" --hide/-H TYPE Comma-separated list of types of messages to hide (start,pass,fail,skip,lost)
\n
"
+++
" --run/-r EXE Execute tests from executable EXE
\n
"
+++
" --option/-O OPT Add OPT to the command line of the previously added run
\n
"
+++
" --name/-n NAME Give the previously added run the name NAME
\n
"
" --help/-h Show this help
\n
"
+++
" --hide/-H TYPE Comma-separated list of types of messages to hide (start,pass,fail,skip,lost)
\n
"
+++
" --output-format/-f FMT The output format (json,human)
\n
"
+++
" --run/-r EXE Execute tests from executable EXE
\n
"
+++
" --option/-O OPT Add OPT to the command line of the previously added run
\n
"
+++
" --name/-n NAME Give the previously added run the name NAME
\n
"
run
::
!
[
MessageType
]
!
Run
!*
World
->
*
World
run
hide
r
w
run
::
!
Options
!
Run
!*
World
->
*
World
run
opts
r
w
#
(
io
,
w
)
=
stdio
w
#
io
=
emit
hide
(
StartEvent
{
StartEvent
|
name
=
r
.
Run
.
name
})
io
#
io
=
emit
(
StartEvent
{
StartEvent
|
name
=
r
.
Run
.
name
})
io
#
(
h
,
w
)
=
runProcessIO
r
.
executable
r
.
options
Nothing
w
|
isError
h
#
(
err
,
msg
)
=
fromError
h
#
io
=
emit
hide
(
EndEvent
#
io
=
emit
(
EndEvent
{
name
=
r
.
Run
.
name
,
event
=
Failed
,
message
=
"Failed to execute "
<+
r
.
executable
<+
" ("
<+
err
<+
"; "
<+
msg
<+
")"
...
...
@@ -154,7 +163,7 @@ where
#
(
ss
,
w
)
=
readPipeBlockingMulti
[
pio
.
stdOut
,
pio
.
stdErr
]
w
|
isError
ss
#
(
err
,
msg
)
=
fromError
ss
#
io
=
emit
hide
(
EndEvent
#
io
=
emit
(
EndEvent
{
name
=
r
.
Run
.
name
,
event
=
Failed
,
message
=
"Failed to read child process IO ("
<+
err
<+
"; "
<+
msg
<+
")"
...
...
@@ -163,13 +172,13 @@ where
#
[
out
,
err
:_]
=
fromOk
ss
#
(
output
,
io
)
=
append
out
(\
s
io
->
case
fromJSON
$
fromString
s
of
Nothing
->
io
Just
ev
->
emit
hide
ev
io
)
output
io
Just
ev
->
emit
ev
io
)
output
io
#
w
=
snd
$
fclose
(
stderr
<<<
err
)
w
// Check if child has terminated
#
(
t
,
w
)
=
checkProcess
h
w
|
isError
t
#
(
err
,
msg
)
=
fromError
t
#
io
=
emit
hide
(
EndEvent
#
io
=
emit
(
EndEvent
{
name
=
r
.
Run
.
name
,
event
=
Failed
,
message
=
"Failed to check on child process ("
<+
err
<+
"; "
<+
msg
<+
")"
...
...
@@ -186,10 +195,10 @@ where
,
message
=
"Failed to read child messages"
}
<<<
"
\n
"
=
snd
$
fclose
io
w
#
io
=
emit
hide
(
EndEvent
$
mergeResults
$
map
fromJust
results
)
io
#
io
=
emit
(
EndEvent
$
mergeResults
$
map
fromJust
results
)
io
=
snd
$
fclose
io
w
|
isJust
rcode
#
io
=
emit
hide
(
EndEvent
#
io
=
emit
(
EndEvent
{
name
=
r
.
Run
.
name
,
event
=
Failed
,
message
=
"Child process exited with "
<+
fromJust
rcode
...
...
@@ -215,7 +224,20 @@ where
lost
=
length
(
filter
(\
te
->
te
=:(
StartEvent
_))
tes
)
-
length
(
filter
(\
te
->
te
=:(
EndEvent
_))
tes
)
emit
::
[
MessageType
]
TestEvent
*
File
->
*
File
emit
hide
ev
io
|
isMember
(
messageType
ev
)
hide
=
io
|
otherwise
=
io
<<<
toJSON
ev
<<<
"
\n
"
emit
::
TestEvent
*
File
->
*
File
emit
ev
io
|
isMember
(
messageType
ev
)
opts
.
hide
=
io
|
otherwise
=
case
opts
.
output
of
OF_JSON
->
io
<<<
toJSON
ev
<<<
"
\n
"
OF_HumanReadable
->
io
<<<
humanReadable
ev
<<<
"
\n
"
where
humanReadable
::
TestEvent
->
String
humanReadable
(
StartEvent
se
)
=
"Started: "
+++
se
.
StartEvent
.
name
humanReadable
(
EndEvent
ee
)
=
event
+++
ee
.
EndEvent
.
name
where
event
=
case
ee
.
event
of
Passed
->
"Passed: "
Failed
->
"Failed: "
//Failed _ -> "failed" // TODO reason
Skipped
->
"Got lost: "
//Lost -> "got lost"
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