Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
clean-and-itasks
clean-test-properties
Commits
906de3a6
Verified
Commit
906de3a6
authored
Sep 07, 2018
by
Camil Staps
🚀
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add preliminary support for @invariant (see
#1
)
parent
60d53df2
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
29 additions
and
7 deletions
+29
-7
.gitlab-ci.yml
.gitlab-ci.yml
+0
-2
testproperties.icl
testproperties.icl
+29
-5
No files found.
.gitlab-ci.yml
View file @
906de3a6
...
...
@@ -6,5 +6,3 @@ build:
-
apt-get install -y -qq build-essential subversion
script
:
-
make
variables
:
GIT_SUBMODULE_STRATEGY
:
recursive
testproperties.icl
View file @
906de3a6
...
...
@@ -31,7 +31,7 @@ import Text.Language
import
Clean
.
Doc
import
Clean
.
Parse
import
Clean
.
Parse
.
Comments
import
Clean
.
Types
.
Util
=>
qualified
::
Priority
import
Clean
.
Types
.
Util
=>
qualified
::
Priority
,
::
TypeDef
from
syntax
import
::
FunKind
,
...
...
@@ -39,12 +39,15 @@ from syntax import
::
Ident
{
id_name
},
::
Module
{
mod_defs
,
mod_ident
},
::
Optional
,
::
ParsedDefinition
(
PD_Function
,
PD_TypeSpec
),
::
ParsedDefinition
(
PD_Function
,
PD_
Type
,
PD_
TypeSpec
),
::
ParsedExpr
,
::
ParsedTypeDef
,
::
Position
,
::
Priority
,
::
Rhs
,
::
SymbolType
::
RhsDefsOfType
,
::
SymbolType
,
::
TypeDef
{
td_ident
}
::
Options
=
{
directory
::
!
FilePath
...
...
@@ -236,6 +239,10 @@ handleModule opts fp w
[(
pd
,
id
)
\\
pd
=:(
PD_TypeSpec
pos
id
_
_
_)
<-
dcldefs
],
Just
docstring
<-
[
getComment
pd
documentation
],
Right
(
doc
,_)
<-
[
parseDoc
docstring
]]
[(
id
.
id_name
,
doc
)
\\
pd
=:(
PD_Type
{
td_ident
=
id
})
<-
dcldefs
,
Just
docstring
<-
[
getComment
pd
documentation
],
Right
(
doc
,_)
<-
[
parseDoc
docstring
]]
// Write properties
|
nprops
==
0
=
w
#
w
=
output
INFO
...
...
@@ -281,8 +288,9 @@ where
interleave
g
[
x
:
xs
]
=
[
g
,
x
:
interleave
g
xs
]
generatePropertyModule
::
!
String
!
String
![
String
]
![
String
]
!(
Maybe
ModuleDoc
)
![(!
String
,!
FunctionDoc
)]
->
(!
Int
,
!
Real
,
!
String
)
generatePropertyModule
testmodname
modname
print_options
test_options
mod_doc
fes
![(!
String
,
!
FunctionDoc
)]
![(!
String
,
!
TypeDoc
)]
->
(!
Int
,
!
Real
,
!
String
)
generatePropertyModule
testmodname
modname
print_options
test_options
mod_doc
fes
tes
=
(
length
props
,
coverage
,
tests
)
where
n_props
=
length
props
...
...
@@ -295,6 +303,7 @@ where
,
"import "
+++
modname
,
bootstrap
,
generators_string
,
invariants
,
start
:
[
gp
.
gp_implementation
\\
gp
<-
props
]
]
...
...
@@ -305,6 +314,21 @@ where
bootstrap
=
fromMaybe
""
(
docPropertyBootstrap
=<<
mod_doc
)
invariants
=
join
"
\n\n
"
$
concatMap
(\(_,
td
)
->
map
invariant
td
.
TypeDoc
.
invariants
)
tes
where
invariant
::
Property
->
String
invariant
(
ForAll
name
args
impl
)
=
name
+++
" :: "
<+
Func
(
map
noContext
argtypes
)
(
Type
"Property"
[])
(
concatMap
context
argtypes
)
<+
"
\n
"
+++
name
+++
concat
[
" "
+++
a
\\
(
a
,_)
<-
args
]
+++
" =
\n\t
"
+++
replaceSubString
"
\n
"
"
\n\t
"
impl
where
noContext
(
Func
[]
t
_)
=
t
noContext
t
=
t
context
(
Func
[]
_
c
)
=
c
context
_
=
[]
argtypes
=
map
snd
args
generators
=
[(
"gast_generator_"
<+
i
,
type
,
imp
)
\\
i
<-
[
0
..]
&
PropertyTestGenerator
type
imp
<-
fromMaybe
[]
(
docPropertyTestGenerators
<$>
mod_doc
)]
generators_string
=
join
"
\n\n
"
$
map
makeGenerator
$
generators
...
...
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