diff --git a/share/prolog/oorules/insanity.pl b/share/prolog/oorules/insanity.pl index b99cef92..66792e82 100644 --- a/share/prolog/oorules/insanity.pl +++ b/share/prolog/oorules/insanity.pl @@ -3,6 +3,41 @@ % Sanity checking rules % ============================================================================================ +:- table haveGround/0 as opaque. +:- multifile groundTruth/9. +haveGround :- groundTruth(_, _, _, _, _, _, _, _, _), !. + +% If we have ground truth, did we merge two different classes together? +:- table insanityGroundBadMerge/1 as incremental. +insanityGroundBadMerge(Out) :- + + find(M1, C), + groundTruth(M1, C1, Mname1, _, _, _, _, _, _), + find(M2, C), + iso_dif(M1, M2), + groundTruth(M2, C2, Mname2, _, _, _, _, _, _), + iso_dif(C1, C2), + + % Make sure that this method is not on multiple classes + not(groundTruth(M2, C1, _, _, _, _, _, _, _)), + + Out = ( + logwarnln('Consistency checks failed.~n~Q (~Q::~Q) and ~Q (~Q::~Q) are on the same class, but ground truth says they are on ~Q and ~Q.', [M1, C1, Mname1, M2, C2, Mname2, C1, C2]) + ). + +% If we have ground truth, is VFTableBelongsToClass correct? +:- table insanityVFTableDoesntBelong/1 as incremental. +insanityVFTableDoesntBelong(Out) :- + reasonVFTableBelongsToClass(VFTable, Offset, Class, Rule, VFTableWrite), + groundTruth(VFTable, GVFTableClass, 'vftable', table, vftable, _, _, _, _), + groundTruth(Class, GClass, _Method, _, _, _, _, _, _), + iso_dif(GVFTableClass, GClass), + + Out = ( + logwarnln('Consistency checks failed.~n~Q but ground truth says VFTable ~Q is on ~Q and ~Q is on ~Q.', [reasonVFTableBelongsToClass(VFTable, Offset, Class, Rule, VFTableWrite), VFTable, GVFTableClass, Class, GClass]) + ). + + % If we say we have no base classes, we have no base classes :-) :- table insanityNoBaseConsistency/1 as incremental. insanityNoBaseConsistency(Out) :- @@ -330,6 +365,7 @@ :- table sanityChecks/1 as incremental. sanityChecks(Out) :- + groundSanityChecks(Out); insanityNoBaseConsistency(Out); insanityEmbeddedAndNot(Out); insanityConstructorAndNotConstructor(Out); @@ -348,6 +384,12 @@ insanityContradictoryNOTConstructor(Out); insanityTwoRealDestructorsOnClass(Out). +groundSanityChecks(Out) :- + haveGround, + + (insanityVFTableDoesntBelong(Out); + insanityGroundBadMerge(Out)). + sanityChecks :- sanityChecks(Out) -> diff --git a/share/prolog/oorules/ooprolog.pl b/share/prolog/oorules/ooprolog.pl index 546f0d7c..c6fa024f 100755 --- a/share/prolog/oorules/ooprolog.pl +++ b/share/prolog/oorules/ooprolog.pl @@ -240,6 +240,7 @@ generate_results(Opts) :- check_option(facts(Facts), Opts), option(results(Results), Opts), !, + load_ground(Opts), ( current_prolog_flag(break_level, _) % interactive session -> psolve_no_halt(Facts) ; setup_call_cleanup( @@ -269,17 +270,23 @@ run_with_backtrace(exportJSONTo(JsonFile)) ; true. -%% If there is a ground option, validate results -validate_results(Opts) :- +load_ground(Opts) :- check_option(ground(Ground), Opts) -> setup_call_cleanup( open(Ground, read, Stream), run_with_backtrace( - (loadPredicates(stream(Stream)), - validateResults)), + loadPredicates(stream(Stream)) + ), close(Stream)) ; true. +%% If there is a ground option, validate results +validate_results(Opts) :- + check_option(ground(_Ground), Opts) -> + (load_ground(Opts), + validateResults) + ; true. + /* Local Variables: */ /* mode: prolog */ /* fill-column: 95 */