Skip to content

WIP: Attemt to make the checker cleaner #7

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

WIP: Attemt to make the checker cleaner #7

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
39 changes: 20 additions & 19 deletions simpletest/checker.pl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
[ dotests/0
]).

% I don't realy know why I've put these here anymore
% Enable catching
:- set_prolog_flag(unknown, error).
:- set_prolog_flag(report_error, true).
% Print a one line trace in case an error occurs
Expand All @@ -29,33 +29,34 @@
dotests(Tests).


dotests(Tests) :-
dotests(Tests,Res),
open('result.json', write, Stream),
json_write(Stream,Res),
close(Stream).

% When everyting is parsed the testresults are the results.
% All tets are executed and the result is stored in a test_result(Res) using asertz/1.
% This is needed because backtracking out of setup_call_catcher_cleanup/4 destroys
% all choisepoints taken in the catcher.
dotests([]) :-
findall(R,test_result(R), Res),
open('result.json', write, Stream),
json_write(Stream,Res),
close(Stream).
dotests([],[]).


dotests([[Name, ImplOk,ImplStud,AllowCP,Limit,Cases]|Xs]) :-
verified(Name, ImplOk,ImplStud,AllowCP,Limit,Cases),
dotests(Xs).
dotests([[Name, ImplOk,ImplStud,AllowCP,Limit,Cases]|Xs],[R|Rs]) :-
verified(Name, ImplOk,ImplStud,AllowCP,Limit,Cases, R),
dotests(Xs,Rs).


% Start with an empty result list
verified(Name, ImplOk, ImplStud, AllowCP,Limit, List) :-
verified(Name, ImplOk, ImplStud, AllowCP,Limit, List, []).
verified(Name, ImplOk, ImplStud, AllowCP,Limit, List,Results) :-
verified(Name, ImplOk, ImplStud, AllowCP,Limit, List, Results).

% When all cases are handled write the result to a file
:- use_module(library(http/json)).
verified(Name, _, _, AllowCP,Limit, [], Result) :-
assertz(test_result(res{name: Name,allowcp:AllowCP, inferencelimit:Limit, result:Result})).
verified(Name, _, _, AllowCP,Limit, [], []).

% Checks what the result is of the correct code
verified(Name, ImplOk, ImplStud, AllowCP,Limit, [Arg|RemArgs], Result) :-
verified(Name, ImplOk, ImplStud, AllowCP,Limit, [Arg|RemArgs], Rs) :-
ignore(catch(setup_call_catcher_cleanup(true,
call_with_inference_limit(
catch(apply(ImplOk,Arg),Exception,true),
Expand All @@ -64,12 +65,12 @@
Caught,
(
mkresult(Caught, LimitResult,Exception, Smry),
verified_student(Smry, Name, ImplOk, ImplStud, AllowCP,Limit, Arg, RemArgs, Result)
verified_student(Smry, Name, ImplOk, ImplStud, AllowCP,Limit, Arg, RemArgs, Rs)
)),_,true)).

% checks the result of the students code
% Extra catches required
verified_student(Expected, Name, ImplOk, ImplStud, AllowCP,Limit, Arg, RemArgs, Result) :-
verified_student(Expected, Name, ImplOk, ImplStud, AllowCP,Limit, Arg, RemArgs, [R|Rs]) :-
ignore(setup_call_catcher_cleanup(true,
call_with_inference_limit(
catch(apply(ImplStud,Arg),Exception,true),
Expand All @@ -79,8 +80,8 @@
(
H=..[ImplStud|Arg], swritef(C, '%q', [H]),
mkresult(Caught, LimitResult, Exception, Smry),
verified(Name, ImplOk, ImplStud, AllowCP,Limit, RemArgs,
[res{expected:Expected, got:Smry, term:C}|Result])
R = res{expected:Expected, got:Smry, term:C},
verified(Name, ImplOk, ImplStud, AllowCP,Limit, RemArgs, Rs)
))).


Expand All @@ -107,7 +108,7 @@
swritef(Summary, '%q', [Exception]).

mkresult(fail,_,Summary) :- !,
swritef(Summary, '%q', [fail]).
swritef(Summary, '%q', [false]).

mkresult(exit,!,Summary) :- !,
swritef(Summary, '%q', [exit]).
Expand Down