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
G
gast
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
4
Issues
4
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
gast
Commits
a26bd71f
Verified
Commit
a26bd71f
authored
Aug 10, 2019
by
Camil Staps
🚀
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Adapt to new Platform
parent
d7641a8b
Pipeline
#27823
failed with stage
in 37 seconds
Changes
5
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
37 additions
and
39 deletions
+37
-39
Libraries/Gast/CommandLine.icl
Libraries/Gast/CommandLine.icl
+2
-2
Libraries/Gast/StdProperty.dcl
Libraries/Gast/StdProperty.dcl
+2
-2
Libraries/Gast/StdProperty.icl
Libraries/Gast/StdProperty.icl
+5
-5
Libraries/Gast/Testable.dcl
Libraries/Gast/Testable.dcl
+9
-8
Libraries/Gast/Testable.icl
Libraries/Gast/Testable.icl
+19
-22
No files found.
Libraries/Gast/CommandLine.icl
View file @
a26bd71f
...
...
@@ -30,7 +30,7 @@ instance Testable (o1, o2, a) | Testable a
where
evaluate
(_,_,
p
)
g
a
=
evaluate
p
g
a
testname
(_,_,
p
)
=
testname
p
test
module
(_,_,
p
)
=
testmodule
p
test
location
(_,_,
p
)
=
testlocation
p
instance
getOptions
([
Testoption
],
a
,
b
)
where
getOptions
(
opts
,_,_)
=
opts
instance
getPrintOptions
(
a
,
[
PrintOption
],
b
)
where
getPrintOptions
(_,
opts
,_)
=
opts
...
...
@@ -39,7 +39,7 @@ instance Testable ExposedProperty
where
evaluate
(
EP
p
)
g
a
=
evaluate
p
g
a
testname
(
EP
p
)
=
testname
p
test
module
(
EP
p
)
=
testmodule
p
test
location
(
EP
p
)
=
testlocation
p
instance
getOptions
ExposedProperty
where
getOptions
(
EP
p
)
=
getOptions
p
...
...
Libraries/Gast/StdProperty.dcl
View file @
a26bd71f
...
...
@@ -13,7 +13,7 @@ definition module Gast.StdProperty
import
Gast
.
GenLibTest
import
Gast
.
Testable
from
Testing
.
TestEvents
import
::
Relation
from
Testing
.
TestEvents
import
::
TestLocation
,
::
Relation
class
(\/)
infixr
2
a
b
::
!
a
b
->
Property
// Conditional or of arg1 and arg2
class
(/\)
infixr
3
a
b
::
!
a
b
->
Property
// Conditional and of arg1 and arg2
...
...
@@ -54,7 +54,7 @@ classify :: !Bool l !p -> Property | Testable p & genShow{|*|} l
label
::
!
l
!
p
->
Property
|
Testable
p
&
genShow
{|*|}
l
name
::
!
n
!
p
->
Property
|
Testable
p
&
toString
n
module_and_name
::
!
String
!
n
!
p
->
Property
|
Testable
p
&
toString
n
location_and_name
::
!
TestLocation
!
n
!
p
->
Property
|
Testable
p
&
toString
n
/**
* Assigns a name to a testable property.
...
...
Libraries/Gast/StdProperty.icl
View file @
a26bd71f
...
...
@@ -27,12 +27,12 @@ import Gast.ThunkNames
instance
==>
Bool
where
(==>)
c
p
|
c
=
Prop
(
"Bool ==> "
+++
testname
p
)
(
test
module
p
)
(
evaluate
p
)
=
Prop
(
"Bool ==> "
+++
testname
p
)
(
test
module
p
)
(\
rs
r
=
[{
r
&
res
=
Rej
}])
|
c
=
Prop
(
"Bool ==> "
+++
testname
p
)
(
test
location
p
)
(
evaluate
p
)
=
Prop
(
"Bool ==> "
+++
testname
p
)
(
test
location
p
)
(\
rs
r
=
[{
r
&
res
=
Rej
}])
instance
==>
Property
where
(==>)
c
=:(
Prop
n
_
_)
p
=
Prop
(
n
+++
" ==> "
+++
testname
p
)
(
test
module
p
)
imp
(==>)
c
=:(
Prop
n
_
_)
p
=
Prop
(
n
+++
" ==> "
+++
testname
p
)
(
test
location
p
)
imp
where
imp
rs
r
#
r1
=
testAnalysis
r
(
evaluate
c
rs
r
)
...
...
@@ -214,8 +214,8 @@ label l p = Prop (testname p) Nothing (\rs r = evaluate p rs {r & labels = [show
name
::
!
n
!
p
->
Property
|
Testable
p
&
toString
n
name
n
p
=
Prop
(
toString
n
)
Nothing
(\
rs
r
->
evaluate
p
rs
{
r
&
namePath
=[
toString
n
:
r
.
namePath
]})
module_and_name
::
!
String
!
n
!
p
->
Property
|
Testable
p
&
toString
n
module_and_name
m
n
p
=
Prop
(
toString
n
)
(
Just
m
)
\
rs
r
->
evaluate
p
rs
{
r
&
namePath
=[
toString
n
:
r
.
namePath
]}
location_and_name
::
!
TestLocation
!
n
!
p
->
Property
|
Testable
p
&
toString
n
location_and_name
l
n
p
=
Prop
(
toString
n
)
(
Just
l
)
\
rs
r
->
evaluate
p
rs
{
r
&
namePath
=[
toString
n
:
r
.
namePath
]}
limitNrOfRecFieldValues
::
!(
Map
(
TypeName
,
RecFieldName
)
Int
)
!
p
->
Property
|
Testable
p
limitNrOfRecFieldValues
limits
p
=
Prop
(
testname
p
)
Nothing
(\
rs
r
=
evaluate
p
rs
{
Admin
|
r
&
recFieldValueNrLimits
=
limits
})
...
...
Libraries/Gast/Testable.dcl
View file @
a26bd71f
...
...
@@ -15,7 +15,7 @@ from StdMaybe import :: Maybe(Nothing)
import
Gast
.
GenLibTest
from
Gast
.
StdProperty
import
::
Property
// for instance of testable
import
Gast
.
Gen
from
Testing
.
TestEvents
import
::
CounterExample
,
::
FailedAssertion
from
Testing
.
TestEvents
import
::
TestLocation
,
::
CounterExample
,
::
FailedAssertion
from
Text
.
GenPrint
import
class
PrintOutput
,
::
PrintState
,
generic
gPrint
//--- basics --//
...
...
@@ -35,18 +35,19 @@ newAdmin :: Admin
derive
gLess
Result
instance
==
Result
::
Property
=
Prop
String
(
Maybe
String
)
(
GenState
Admin
->
[
Admin
])
::
Property
=
Prop
String
(
Maybe
TestLocation
)
(
GenState
Admin
->
[
Admin
])
prop
::
a
->
Property
|
Testable
a
class
TestArg
a
|
genShow
{|*|},
ggen
{|*|},
gPrint
{|*|}
a
class
Testable
a
where
evaluate
::
!
a
GenState
!
Admin
->
[
Admin
]
testname
::
a
->
String
test
module
::
a
->
Maybe
String
test
module
_
=
Nothing
test
location
::
a
->
Maybe
TestLocation
test
location
_
=
Nothing
instance
Testable
Bool
instance
Testable
Result
...
...
@@ -117,8 +118,8 @@ generateAll :: !GenState -> [a] | ggen{|*|} a //& genType{|*|} a
}
::
GastEvent
=
GE_TestStarted
!(
Maybe
String
)
!
String
|
GE_TestFinished
!(
Maybe
String
)
!
String
!
TestsResult
![
CounterExampleRes
]
![(
String
,
Int
)]
=
GE_TestStarted
!(
Maybe
TestLocation
)
!
String
|
GE_TestFinished
!(
Maybe
TestLocation
)
!
String
!
TestsResult
![
CounterExampleRes
]
![(
String
,
Int
)]
|
GE_CounterExample
!
CounterExampleRes
|
GE_Tick
!
Int
!
Admin
...
...
@@ -132,8 +133,8 @@ generateAll :: !GenState -> [a] | ggen{|*|} a //& genType{|*|} a
::
PrintConfig
=
{
everyOutput
::
Int
Admin
->
String
,
counterExampleOutput
::
CounterExampleRes
->
String
,
beforeStartOutput
::
(
Maybe
String
)
String
->
String
,
resultOutput
::
(
Maybe
String
)
String
TestsResult
[
CounterExampleRes
]
[(
String
,
Int
)]
->
String
,
beforeStartOutput
::
(
Maybe
TestLocation
)
String
->
String
,
resultOutput
::
(
Maybe
TestLocation
)
String
TestsResult
[
CounterExampleRes
]
[(
String
,
Int
)]
->
String
}
printEvents
::
PrintConfig
[
GastEvent
]
->
[
String
]
...
...
Libraries/Gast/Testable.icl
View file @
a26bd71f
...
...
@@ -52,7 +52,7 @@ instance Testable Property
where
evaluate
(
Prop
_
_
p
)
genState
result
=
p
genState
result
testname
(
Prop
n
_
_)
=
n
test
module
(
Prop
_
m
_)
=
m
test
location
(
Prop
_
l
_)
=
l
instance
Testable
(
a
->
b
)
|
Testable
b
&
genShow
{|*|}
a
&
ggen
{|*|}
a
&
TestArg
a
where
...
...
@@ -60,18 +60,15 @@ where
where
genState`
=
{
GenState
|
genState
&
recFieldValueNrLimits
=
admin
.
Admin
.
recFieldValueNrLimits
}
testname
f
=
thunk_name_to_string
f
test
module
f
=
Just
(
thunk_to_module_name_string
f
)
test
location
f
=
Just
{
loc_module
=
Just
(
thunk_to_module_name_string
f
)}
instance
Testable
[
a
]
|
Testable
a
where
evaluate
list
genState
admin
=
diagonal
[
evaluate
x
genState
admin
\\
x
<-
list
]
// copy the genState
testname
xs
=
"["
+++
join
","
(
map
testname
xs
)
+++
"]"
testmodule
xs
=
case
removeDup
[
testmodule
x
\\
x
<-
xs
]
of
[
m
]
->
m
_
->
Nothing
prop
::
a
->
Property
|
Testable
a
prop
p
=
Prop
(
testname
p
)
(
test
module
p
)
(
evaluate
p
)
prop
p
=
Prop
(
testname
p
)
(
test
location
p
)
(
evaluate
p
)
forAll
::
!(
a
->
b
)
![
a
]
GenState
!
Admin
->
[
Admin
]
|
Testable
b
&
TestArg
a
forAll
f
[]
genState
r
=:{
Admin
|
args
}
=
[{
r
&
args
=
reverse
args
,
res
=
OK
}]
// to handle empty sets of values
...
...
@@ -115,8 +112,8 @@ printEvents pc [ge:ges] = case s of
s
->
[
s
:
printEvents
pc
ges
]
where
s
=
case
ge
of
GE_TestStarted
m
n
->
pc
.
beforeStartOutput
m
n
GE_TestFinished
m
n
r
ces
labels
->
pc
.
resultOutput
m
n
r
ces
labels
GE_TestStarted
l
n
->
pc
.
beforeStartOutput
l
n
GE_TestFinished
l
n
r
ces
labels
->
pc
.
resultOutput
l
n
r
ces
labels
GE_CounterExample
ce
->
pc
.
counterExampleOutput
ce
GE_Tick
n
adm
->
pc
.
everyOutput
n
adm
printEvents
_
[]
=
[]
...
...
@@ -176,7 +173,7 @@ testEventsPrintConfig =
noCounterExampleOutput
::
CounterExampleRes
->
String
noCounterExampleOutput
_
=
""
noBeforeOutput
::
!(
Maybe
String
)
!
String
->
String
noBeforeOutput
::
!(
Maybe
TestLocation
)
!
String
->
String
noBeforeOutput
_
_
=
""
noEveryOutput
::
!
Int
Admin
->
String
...
...
@@ -200,7 +197,7 @@ where
showFailedAssertion
::
!(!
FailedAssertion
,
!
String
,
!
String
)
->
[
String
]
showFailedAssertion
(
ExpectedRelation
_
rel
_,
x
,
y
)
=
[
"not ("
,
x
,
" "
,
toString
rel
,
" "
,
y
,
")
\n
"
]
humanReadableResOutput
::
Bool
(
Maybe
String
)
String
TestsResult
[
CounterExampleRes
]
[(
String
,
Int
)]
->
String
humanReadableResOutput
::
Bool
(
Maybe
TestLocation
)
String
TestsResult
[
CounterExampleRes
]
[(
String
,
Int
)]
->
String
humanReadableResOutput
addWhite
_
name
{
maxTests
,
nRej
,
resultType
}
_
labels
=
withBlank
$
showName
True
name
+++
resStr
where
resStr
=
case
resultType
of
...
...
@@ -240,18 +237,18 @@ where
showLabels
0
[(
lab
,
n
):
rest
]
=
[
"
\n
"
,
lab
,
": "
,
toString
n
:
showLabels
0
rest
]
showLabels
ntests
[(
lab
,
n
):
rest
]
=
[
"
\n
"
,
lab
,
": "
,
toString
n
,
" ("
,
toString
(
toReal
(
n
*
100
)/
toReal
ntests
),
"%)"
:
showLabels
ntests
rest
]
jsonEventStart
::
!(
Maybe
String
)
!
String
->
String
jsonEventStart
mod
name
=
toString
(
toJSON
{
StartEvent
|
name
=
name
,
module_name
=
mod
})
+++
"
\n
"
jsonEventStart
::
!(
Maybe
TestLocation
)
!
String
->
String
jsonEventStart
loc
name
=
toString
(
toJSON
{
StartEvent
|
name
=
name
,
location
=
loc
})
+++
"
\n
"
jsonEventEnd
::
!(
Maybe
String
)
!
String
!
TestsResult
![
CounterExampleRes
]
![(
String
,
Int
)]
->
String
jsonEventEnd
mod
name
res
counterExamples
labels
=
toString
(
toJSON
endEvent
)
+++
"
\n
"
jsonEventEnd
::
!(
Maybe
TestLocation
)
!
String
!
TestsResult
![
CounterExampleRes
]
![(
String
,
Int
)]
->
String
jsonEventEnd
loc
name
res
counterExamples
labels
=
toString
(
toJSON
endEvent
)
+++
"
\n
"
where
endEvent
=
{
name
=
showName
False
name
,
module_name
=
mod
,
event
=
eventType
,
message
=
concat
[
humanReadableResOutput
False
mod
name
res
counterExamples
labels
{
name
=
showName
False
name
,
location
=
loc
,
event
=
eventType
,
message
=
concat
[
humanReadableResOutput
False
loc
name
res
counterExamples
labels
:
map
(
humanReadableCEOutput
False
False
)
counterExamples
]
}
...
...
@@ -354,14 +351,14 @@ testEventsn n rs p = printEvents testEventsPrintConfig $ testConfig rs { default
testConfig
::
RandomStream
Config
p
->
[
GastEvent
]
|
Testable
p
testConfig
rs
{
maxTests
,
maxArgs
,
fails
,
genState
}
p
#
res
=
evaluate
p
genState
newAdmin
=
[
GE_TestStarted
(
test
module
p
)
(
testname
p
):
analyse
res
maxTests
maxArgs
0
0
0
[]
[]]
=
[
GE_TestStarted
(
test
location
p
)
(
testname
p
):
analyse
res
maxTests
maxArgs
0
0
0
[]
[]]
where
analyse
::
![.
Admin
]
!
Int
!
Int
!
Int
!
Int
!
Int
[
CounterExampleRes
]
![(
String
,
Int
)]
->
[
GastEvent
]
analyse
results
nTests
nArgs
nRej
nUnd
nE
counterExamples
labels
=
case
analyse`
results
nTests
nArgs
nRej
nUnd
nE
of
// testing of property finished
Just
resType
->
[
GE_TestFinished
(
test
module
p
)
(
testname
p
)
(
test
location
p
)
(
testname
p
)
{
maxTests
=
maxTests
,
nRej
=
nRej
,
resultType
=
resType
}
counterExamples
labels
]
...
...
@@ -385,7 +382,7 @@ where
more
|
nE
+1
<
fails
=
analyse
rest
(
nTests
-1
)
(
nArgs
-1
)
nRej
nUnd
(
nE
+1
)
[
counterExample
:
counterExamples
]
(
admin
res
.
labels
labels
)
=
[
GE_TestFinished
(
test
module
p
)
(
testname
p
)
(
test
location
p
)
(
testname
p
)
{
maxTests
=
maxTests
,
nRej
=
nRej
,
resultType
=
CounterExpls
(
nTests
-
1
)
nUnd
(
nE
+
1
)
...
...
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