Implement support for IO Bool tests

This commit is contained in:
Nathan McCarty 2024-12-31 18:12:35 -05:00
parent c089685a2a
commit 09ac7506ee
4 changed files with 49 additions and 11 deletions

View file

@ -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);

View file

@ -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 {

View file

@ -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);

View file

@ -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 {