Implement support for IO Bool tests
This commit is contained in:
parent
c089685a2a
commit
09ac7506ee
|
@ -43,10 +43,10 @@ multi MAIN(
|
|||
for $module.tests -> $test {
|
||||
try {
|
||||
# FIXME this doesn't actually capture the exit code
|
||||
idris-exec $test.expr, $module.source.relative;
|
||||
idris-exec $test.expr, $module.source.relative, $test.output-type;
|
||||
}
|
||||
my $testf = colored $test.name, 'underline';
|
||||
if $! {
|
||||
if $! ~~ ExpressionError {
|
||||
# TODO: Don't show stdout if its empty
|
||||
$module-failures += 1;
|
||||
say "{colored '+', 'red'} $testf: {colored 'FAIL', 'red bold'}"
|
||||
|
@ -55,6 +55,8 @@ multi MAIN(
|
|||
say $!.err.lines.map(*.indent(8)).join("\n");
|
||||
say (colored 'exit code', 'red').indent(6),
|
||||
": {$!.exit-code}";
|
||||
} elsif $! {
|
||||
die $!;
|
||||
} else {
|
||||
say "{colored '+', 'green'} $testf: {colored 'pass', 'green'}"
|
||||
.indent(4);
|
||||
|
|
|
@ -4,6 +4,7 @@ unit module IUtils;
|
|||
need IUtils::IDEMode;
|
||||
|
||||
use IUtils::Regexes;
|
||||
use IUtils::Compiler;
|
||||
|
||||
use paths;
|
||||
|
||||
|
@ -13,6 +14,8 @@ class Test {
|
|||
has Str:D $.name is required;
|
||||
#| The expression name of the test
|
||||
has Str:D $.expr is required;
|
||||
#| The output type of the test
|
||||
has ExprOutput:D $.output-type is required;
|
||||
}
|
||||
|
||||
#| Structure representing the tests in a module
|
||||
|
@ -51,9 +54,17 @@ class PackageInfo {
|
|||
my $module-name = $<name>.Str;
|
||||
my @tests;
|
||||
for $contents.match(&flagged-expression, :g) -> $match {
|
||||
my $output-type = do
|
||||
given $match<output-type> {
|
||||
when * eq '()' {succeed Unit};
|
||||
when * eq 'Bool' {succeed Boolean};
|
||||
when * eq 'Either' {succeed Either};
|
||||
};
|
||||
say $output-type;
|
||||
my $test =
|
||||
Test.new(name => $match<test-name>.Str,
|
||||
expr => $match<expression-name>.Str);
|
||||
expr => $match<expression-name>.Str,
|
||||
output-type => $output-type);
|
||||
@tests.push($test);
|
||||
}
|
||||
if @tests.elems > 0 {
|
||||
|
|
|
@ -1,6 +1,9 @@
|
|||
#| Utilities for interacting with the idris compiler and package manager
|
||||
unit module IUtils::Compiler;
|
||||
|
||||
# Represents the output of an Expr that we need to run
|
||||
enum ExprOutput is export <Unit Boolean Either>;
|
||||
|
||||
# Utility functions for pack
|
||||
|
||||
#| Invoke a pack command
|
||||
|
@ -53,7 +56,7 @@ class IdrisError is Exception {
|
|||
}
|
||||
|
||||
#| An error coming from a compiled expression
|
||||
class ExpressionError is Exception {
|
||||
class ExpressionError is Exception is export {
|
||||
has Str $.out;
|
||||
has Str $.err;
|
||||
has Int $.exit-code;
|
||||
|
@ -81,11 +84,27 @@ sub idris-run(*@cmd) is export {
|
|||
return $out;
|
||||
}
|
||||
|
||||
# TODO: Special handling for IO Bool to make this eaiser
|
||||
#| Exec the expression with the given name in the given file
|
||||
sub idris-exec($expr, $file) is export {
|
||||
my constant $bool-lambda =
|
||||
'(\x => if x then exitSuccess else exitFailure)';
|
||||
|
||||
# TODO: Implemenent support for the Either case
|
||||
# TODO: Use the ide protocol to drive this so we can avoid the user needing to
|
||||
# import anything
|
||||
# Exec the expression with the given name in the given file
|
||||
sub idris-exec($expr, $file, $output-type? = Unit) is export {
|
||||
# Have idris compile an executable for the expression,
|
||||
idris-run '--find-ipkg', '--client', ":c iutils_out $expr", $file;
|
||||
given $output-type {
|
||||
when Unit {
|
||||
idris-run '--find-ipkg', '--client', ":c iutils_out $expr", $file;
|
||||
}
|
||||
when Boolean {
|
||||
idris-run '--find-ipkg', '--client',
|
||||
":c iutils_out ($expr >>= $bool-lambda)", $file;
|
||||
}
|
||||
default {
|
||||
die "Unsupported output type encountered: $_";
|
||||
}
|
||||
}
|
||||
# Run the expression
|
||||
my $proc = run 'build/exec/iutils_out', :out, :err;
|
||||
my $out = $proc.out.slurp(:close);
|
||||
|
|
|
@ -1,16 +1,22 @@
|
|||
unit module IUtils::Regexes;
|
||||
|
||||
my token comment-start { \- \- }
|
||||
my token type {
|
||||
'test' | 'bench'
|
||||
}
|
||||
my token output-type {
|
||||
'()' | 'Bool' | 'Either'
|
||||
}
|
||||
|
||||
my token comment-start { \- \- }
|
||||
my token flag { \@ \@ <type> }
|
||||
my token name { <[\w \-]>+ }
|
||||
|
||||
my token comment-line { <&comment-start> \V* \v }
|
||||
|
||||
my regex flagged-expression is export {
|
||||
<&comment-start> \h* <flag> \h* <test-name=&name> \V* \v
|
||||
[<&comment-start> \V* \v]*
|
||||
<expression-name=&name> \h+ \: \V* \v
|
||||
<comment-line>*
|
||||
<expression-name=&name> \h+ \: \h+ 'IO' \h+ <output-type> \V* \v
|
||||
}
|
||||
|
||||
my regex module-name is export {
|
||||
|
|
Loading…
Reference in a new issue