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
I
iTasks-SDK
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
74
Issues
74
List
Boards
Labels
Service Desk
Milestones
Merge Requests
6
Merge Requests
6
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
iTasks-SDK
Commits
27694f98
Commit
27694f98
authored
Jul 04, 2018
by
Bas Lijnse
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Updated codequality monitor tool to compile and run clean-test based unit tests
parent
fc49eb94
Pipeline
#12658
failed with stage
in 1 minute and 27 seconds
Changes
4
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
71 additions
and
87 deletions
+71
-87
Libraries/iTasks/Extensions/Development/Testing.dcl
Libraries/iTasks/Extensions/Development/Testing.dcl
+4
-3
Libraries/iTasks/Extensions/Development/Testing.icl
Libraries/iTasks/Extensions/Development/Testing.icl
+33
-54
Tools/CodeQualityMonitor.icl
Tools/CodeQualityMonitor.icl
+33
-29
Tools/CodeQualityMonitor.prj.default
Tools/CodeQualityMonitor.prj.default
+1
-1
No files found.
Libraries/iTasks/Extensions/Development/Testing.dcl
View file @
27694f98
...
...
@@ -4,8 +4,9 @@ definition module iTasks.Extensions.Development.Testing
*/
import
iTasks
from
Testing
.
TestEvents
import
::
EndEventType
from
Testing
.
TestEvents
import
::
EndEvent
,
::
EndEvent
Type
from
iTasks
.
Util
.
Testing
import
::
TestReport
from
iTasks
.
Extensions
.
Development
.
Codebase
import
::
CleanModuleName
,
::
ModuleName
compileTestModule
::
FilePath
->
Task
EndEventType
runTestModule
::
FilePath
->
Task
EndEventType
compileTestModule
::
CleanModuleName
->
Task
EndEvent
runTestModule
::
CleanModuleName
->
Task
[
EndEvent
]
Libraries/iTasks/Extensions/Development/Testing.icl
View file @
27694f98
...
...
@@ -4,78 +4,57 @@ import System.Time
import
Testing
.
TestEvents
import
iTasks
.
Util
.
Testing
import
iTasks
.
Extensions
.
Files
import
iTasks
.
Extensions
.
Development
.
Tools
import
Text
,
Data
.
Tuple
,
Data
.
Error
,
System
.
FilePath
,
System
.
OS
import
iTasks
.
Extensions
.
Development
.
Codebase
import
Text
,
Data
.
Tuple
,
Data
.
Error
,
Data
.
Func
,
System
.
FilePath
,
System
.
OS
TESTS_PATH
:==
"../Tests/TestPrograms"
//:: CompileError = CompileError !Int
derive
class
iTask
EndEventType
derive
gEditor
FailReason
,
FailedAssertion
,
CounterExample
,
Relation
derive
gText
FailReason
,
FailedAssertion
,
CounterExample
,
Relation
derive
gDefault
FailReason
,
FailedAssertion
,
CounterExample
,
Relation
derive
gEq
FailReason
,
FailedAssertion
,
CounterExample
,
Relation
compileTestModule
::
FilePath
->
Task
EndEventType
compileTestModule
path
=
traceValue
path
>>|
get
cpmExecutable
>>-
\
cpm
->
runWithOutput
cpm
[
"project"
,
base
,
"create"
]
(
Just
baseDir
)
>>-
\_
->
runWithOutput
cpm
[
"project"
,
prj
,
"target"
,
"iTasks"
]
(
Just
baseDir
)
>>-
\_
->
runWithOutput
cpm
[
"project"
,
prj
,
"exec"
,
base
+++
".exe"
]
(
Just
baseDir
)
>>-
\_
->
runWithOutput
cpm
[
"project"
,
prj
,
"set"
,
"-h"
,
"200M"
,
"-s"
,
"2M"
,
"-dynamics"
]
(
Just
baseDir
)
>>-
\_
->
runWithOutput
cpm
[
prj
]
(
Just
baseDir
)
//Build the test
@
\(
c
,
o
)
->
if
(
passed
c
o
)
Passed
(
Failed
Nothing
)
derive
gEditor
EndEvent
,
FailReason
,
FailedAssertion
,
CounterExample
,
Relation
derive
gText
EndEvent
,
FailReason
,
FailedAssertion
,
CounterExample
,
Relation
derive
gDefault
EndEvent
,
FailReason
,
FailedAssertion
,
CounterExample
,
Relation
derive
gEq
EndEvent
,
FailReason
,
FailedAssertion
,
CounterExample
,
Relation
compileTestModule
::
CleanModuleName
->
Task
EndEvent
compileTestModule
(
path
,
name
)
=
copyFile
prjDefaultPath
prjPath
>>-
\_
->
get
cpmExecutable
>>-
\
cpm
->
runWithOutput
cpm
[
prjPath
]
Nothing
//Build the test
@
\(
c
,
o
)
->
if
(
passed
c
o
)
{
name
=
testName
,
event
=
Passed
,
message
=
join
""
o
}
{
name
=
testName
,
event
=
(
Failed
Nothing
),
message
=
join
""
o
}
where
testName
=
"Compile: "
+++
name
iclPath
=
cleanFilePath
(
path
,
name
,
Icl
)
prjDefaultPath
=
path
</>
name
+++
".prj.default"
prjPath
=
path
</>
name
+++
".prj"
//Cpm still returns exitcode 0 on failure, so we have to check the output
passed
0
o
=
let
lines
=
split
OS_NEWLINE
(
join
""
o
)
in
not
(
any
isErrorLine
lines
)
passed
_
_
=
False
isErrorLine
l
=
startsWith
"Error"
l
||
startsWith
"Type error"
l
||
startsWith
"Parse error"
l
baseDir
=
takeDirectory
path
base
=
takeFileName
(
dropExtension
path
)
prj
=
takeFileName
(
addExtension
base
"prj"
)
//Copy-paste.. should be in library
runTestModule
::
FilePath
->
Task
EndEventType
runTestModule
path
=
compileTestModule
path
>>-
\
res
->
case
res
of
Passed
=
runWithOutput
exe
[]
Nothing
@
(
parse
SuiteResult
o
appSnd
(
join
""
))
//Run the test
_
=
return
res
runTestModule
::
CleanModuleName
->
Task
[
EndEvent
]
runTestModule
(
path
,
name
)
=
compileTestModule
(
path
,
name
)
>>-
\
res
=:{
EndEvent
|
event
}
->
case
event
of
Passed
=
runWithOutput
exe
[]
Nothing
@
(
parse
TestResults
o
appSnd
(
join
""
))
//Run the test
_
=
return
[
res
]
where
exe
=
IF_WINDOWS
(
base
</>
addExtension
name
"exe"
)
(
path
</>
name
)
baseDir
=
takeDirectory
path
base
=
dropExtension
path
exe
=
addExtension
base
"exe"
parseSuiteResult
::
(
Int
,
String
)
->
EndEventType
//QUICK AND DIRTY PARSER
parseSuiteResult
(
ecode
,
output
)
#
lines
=
split
"
\n
"
output
parseTestResults
(
ecode
,
output
)
#
lines
=
split
OS_NEWLINE
output
|
length
lines
<
2
=
fallback
ecode
output
#
suiteName
=
trim
((
split
":"
(
lines
!!
0
))
!!
1
)
#
results
=
[
parseRes
resLines
\\
resLines
<-
splitLines
(
drop
3
lines
)
|
length
resLines
>=
2
]
=
Passed
//= {SuiteResult|suiteName=suiteName,testResults=results}
=
[
res
\\
Just
res
<-
map
(
fromJSON
o
fromString
)
lines
]
where
splitLines
lines
=
split`
lines
[[]]
where
split`
[
""
:
lines
]
acc
=
split`
lines
[[]:
acc
]
split`
[
l
:
lines
]
[
h
:
acc
]
=
split`
lines
[[
l
:
h
]:
acc
]
split`
[]
acc
=
reverse
(
map
reverse
acc
)
parseRes
[
nameLine
,
resultLine
:
descLines
]
#
name
=
trim
((
split
":"
nameLine
)
!!
1
)
#
result
=
case
resultLine
of
"Result: Passed"
=
Passed
"Result: Skipped"
=
Skipped
//_ = Failed (if (descLines =: []) Nothing (Just (join "\n" descLines)))
_
=
Failed
(
if
(
descLines
=:
[])
Nothing
(
Just
Crashed
))
=
(
name
,
result
)
parseRes
_
=
(
"oops"
,
Failed
Nothing
)
//If we can't parse the output, We'll treat it as a single simple test executable
fallback
0
_
=
Passed
//{SuiteResult|suiteName="Unknown",testResults=[("executable",Passed)]}
fallback
_
output
=
Failed
Nothing
//{SuiteResult|suiteName="Unknown",testResults=[("executable",Failed (Just output))]}
fallback
0
_
=
[{
name
=
name
,
event
=
Passed
,
message
=
"Execution returned 0"
}]
fallback
_
output
=
[{
name
=
name
,
event
=
Failed
Nothing
,
message
=
output
}]
runWithOutput
::
FilePath
[
String
]
(
Maybe
FilePath
)
->
Task
(
Int
,[
String
])
runWithOutput
prog
args
dir
=
withShared
([],
[])
\
out
->
withShared
[]
\
stdin
->
...
...
Tools/CodeQualityMonitor.icl
View file @
27694f98
...
...
@@ -38,17 +38,17 @@ EXAMPLE_MODULES :== ["../Examples/BasicApiExamples.icl"
derive
class
iTask
EndEventType
derive
gEditor
FailReason
,
FailedAssertion
,
CounterExample
,
Relation
derive
gDefault
FailReason
,
FailedAssertion
,
CounterExample
,
Relation
derive
gEq
FailReason
,
FailedAssertion
,
CounterExample
,
Relation
derive
gText
FailReason
,
FailedAssertion
,
CounterExample
,
Relation
derive
gEditor
EndEvent
,
FailReason
,
FailedAssertion
,
CounterExample
,
Relation
derive
gDefault
EndEvent
,
FailReason
,
FailedAssertion
,
CounterExample
,
Relation
derive
gEq
EndEvent
,
FailReason
,
FailedAssertion
,
CounterExample
,
Relation
derive
gText
EndEvent
,
FailReason
,
FailedAssertion
,
CounterExample
,
Relation
inspectCodeQuality
::
Task
()
inspectCodeQuality
=
application
{
WebImage
|
src
=
"/testbench.png"
,
alt
=
"iTasks Testbench"
,
width
=
200
,
height
=
50
}
(
allTasks
[
Title
"Unit Tests"
@>>
runUnitTests
,
Title
"Interactive Tests"
@>>
runInteractiveTests
,
Title
"Example applications"
@>>
checkExampleApplications
//
,Title "Example applications" @>> checkExampleApplications
,
Title
"Code"
@>>
exploreCode
,
Title
"Experiment"
@>>
inspectMainModule
"test"
"module test
\n
Start =
\"
Hello World
\"
"
]
<<@
ArrangeWithTabs
False
...
...
@@ -59,12 +59,12 @@ where
runInteractiveTests
::
Task
()
runInteractiveTests
=
(
editSelectionWithShared
(
Title
"Select test"
)
False
(
SelectInTree
c
ollectionToTree
selectTest
)
tests
(
const
[])
@?
tvHd
=
(
editSelectionWithShared
(
Title
"Select test"
)
False
(
SelectInTree
fileC
ollectionToTree
selectTest
)
tests
(
const
[])
@?
tvHd
>&>
withSelection
(
viewInformation
()
[]
"Select a test"
)
testInteractive
)
<<@
ArrangeWithSideBar
0
LeftSide
250
True
@!
()
where
tests
=
sdsFocus
INTERACTIVE_TESTS_PATH
(
fileCollection
(\
path
isDirectory
->
isDirectory
||
takeExtension
path
==
"icl"
)
False
)
c
ollectionToTree
collection
=
itemsToTree
[]
collection
fileC
ollectionToTree
collection
=
itemsToTree
[]
collection
where
itemsToTree
prefix
subCollection
=
map
(
itemToTree
prefix
)
('
DM
'.
toList
subCollection
)
...
...
@@ -88,38 +88,42 @@ where
runUnitTests
::
Task
()
runUnitTests
=
withShared
'
DM
'.
newMap
\
results
->
(
(
enterChoiceWithSharedAs
()
[
ChooseFromGrid
fst
]
(
testsWithResults
results
)
fst
>&>
withSelection
(
viewInformation
"Select a test"
[]
())
(\
path
->
(
viewSharedInformation
(
Title
"Code"
)
[
ViewUsing
id
aceTextArea
]
(
sdsFocus
(
UNIT_TESTS_PATH
</>
path
)
(
removeMaybe
Nothing
fileShare
))
-&&-
viewSharedInformation
(
Title
"Results"
)
[
ViewAs
(
toTestReport
o
maybeToList
)]
(
mapRead
('
DM
'.
get
path
)
results
)
<<@
ArrangeHorizontal
)
((
((
editSelectionWithShared
(
Title
"Tests"
)
False
(
SelectInTree
toModuleSelectTree
selectByIndex
)
(
sdsFocus
UNIT_TESTS_PATH
moduleList
)
(
const
[])
@?
tvHd
)
)
>&>
withSelection
(
viewInformation
"Select a test"
[]
())
(
viewTest
results
)
)
@!
())
<<@
ArrangeWithSideBar
0
LeftSide
250
True
where
selectByIndex
nodes
indices
=
[
nodes
!!
i
\\
i
<-
indices
|
i
>=
0
&&
i
<
length
nodes
]
viewTest
results
(
name
,_)
=
(
viewSharedInformation
(
Title
"Code"
)
[
ViewUsing
(
join
"
\n
"
)
aceTextArea
]
(
sdsFocus
(
UNIT_TESTS_PATH
,
name
)
moduleImplementation
)
-&&-
((
viewSharedInformation
(
Title
"Results"
)
[
ViewAs
(
toTestReport
o
maybeToList
)]
(
mapRead
('
DM
'.
get
name
)
results
)
<<@
ArrangeHorizontal
)
>^*
[
OnAction
(
Action
"Run"
)
(
always
(
runTestModule
(
UNIT_TESTS_PATH
</>
path
)
<<@
InWindow
>>-
\
res
->
(
upd
('
DM
'.
put
path
res
))
results
(
runTestModule
(
UNIT_TESTS_PATH
,
name
)
<<@
InWindow
>>-
\
res
->
(
upd
('
DM
'.
put
name
res
))
results
)
)]
)
@!
())
<<@
ArrangeWithSideBar
0
LeftSide
250
True
)
where
testsWithResults
results
=
mapRead
(\(
res
,
tests
)
->
[(
t
,'
DM
'.
get
t
res
)
\\
t
<-
tests
])
(
results
|*|
tests
)
where
tests
=
mapRead
(
filter
((==)
"icl"
o
takeExtension
))
(
sdsFocus
UNIT_TESTS_PATH
directoryListing
)
)
@!
())
<<@
ArrangeWithSideBar
1
RightSide
400
True
toTestReport
results
=
DivTag
[]
[
]
//[suite
Html res \\ res <- results | not (isEmpty results)]
=
DivTag
[]
[
set
Html
res
\\
res
<-
results
|
not
(
isEmpty
results
)]
where
s
uite
Html
testResults
s
et
Html
testResults
=
TableTag
[
StyleAttr
"width: 100%"
]
[
headerRow
:
map
resultRow
testResults
]
headerRow
=
TrTag
[]
[
ThTag
[]
[
Text
"Test"
],
ThTag
[]
[
Text
"Result"
],
ThTag
[]
[
Text
"Details"
]]
resultRow
Passed
=
TrTag
[]
[
TdTag
[]
[
Text
"FIXME"
],
TdTag
[]
[
SpanTag
[
StyleAttr
"color: green"
]
[
Text
"Passed"
]],
TdTag
[]
[
]]
resultRow
Skipped
=
TrTag
[]
[
TdTag
[]
[
Text
"FIXME"
],
TdTag
[]
[
SpanTag
[
StyleAttr
"color: orange"
]
[
Text
"Skipped"
]],
TdTag
[]
[
]]
resultRow
(
Failed
Nothing
)
=
TrTag
[]
[
TdTag
[]
[
Text
"FIXME"
],
TdTag
[]
[
SpanTag
[
StyleAttr
"color: red"
]
[
Text
"Failed"
]],
TdTag
[]
[
]]
resultRow
(
Failed
(
Just
details
))
=
TrTag
[]
[
TdTag
[]
[
Text
"FIXME"
],
TdTag
[]
[
SpanTag
[
StyleAttr
"color: red"
]
[
Text
"Failed"
]],
TdTag
[]
[
TextareaTag
[]
[
Text
(
toString
(
toJSON
details
))]]]
resultRow
{
name
,
event
=
Passed
,
message
}
=
TrTag
[]
[
TdTag
[]
[
Text
name
],
TdTag
[]
[
SpanTag
[
StyleAttr
"color: green"
]
[
Text
"Passed"
]],
TdTag
[]
[
Text
message
]]
resultRow
{
name
,
event
=
Skipped
,
message
}
=
TrTag
[]
[
TdTag
[]
[
Text
name
],
TdTag
[]
[
SpanTag
[
StyleAttr
"color: orange"
]
[
Text
"Skipped"
]],
TdTag
[]
[
Text
message
]]
resultRow
{
name
,
event
=
Failed
Nothing
,
message
}
=
TrTag
[]
[
TdTag
[]
[
Text
name
],
TdTag
[]
[
SpanTag
[
StyleAttr
"color: red"
]
[
Text
"Failed"
]],
TdTag
[]
[
Text
message
]]
resultRow
{
name
,
event
=
Failed
(
Just
details
),
message
}
=
TrTag
[]
[
TdTag
[]
[
Text
name
],
TdTag
[]
[
SpanTag
[
StyleAttr
"color: red"
]
[
Text
"Failed"
]],
TdTag
[]
[
TextareaTag
[]
[
Text
(
toString
(
toJSON
details
))]]]
/*
checkExampleApplications = withShared 'DM'.newMap
\results ->
(
...
...
@@ -140,6 +144,7 @@ where
examplesWithResults results = mapRead (\(res,examples) -> [(e,'DM'.get e res) \\e <- examples ]) (results |*| examples)
where
examples = constShare EXAMPLE_MODULES
*/
exploreCode
::
Task
()
exploreCode
...
...
@@ -293,7 +298,6 @@ where
]
Start
world
=
startEngine
inspectCodeQuality
world
//Start world = startEngineWithOptions (\cli options -> (Just {options & autoLayout = False},[])) inspectCodeQuality world
//CREATE THIS WITH CPM LIBRARY
projectTemplate
moduleName
=
join
OS_NEWLINE
...
...
Tools/CodeQualityMonitor.prj.default
View file @
27694f98
...
...
@@ -8,7 +8,7 @@ Global
CheckIndexes: True
Application
HeapSize: 209715200
StackSize: 512000
StackSize: 512000
0
ExtraMemory: 8192
IntialHeapSize: 204800
HeapSizeMultiplier: 4096
...
...
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