Start to add ground truth "sanity checks"

Author: sei-eschwartz

share/prolog/oorules/insanity.pl

@@ -3,6 +3,28 @@
 % Sanity checking rules
 % ============================================================================================
 
+:- table haveGround/0 as opaque.
+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 say we have no base classes, we have no base classes :-)
 :- table insanityNoBaseConsistency/1 as incremental.
 insanityNoBaseConsistency(Out) :-
@@ -330,6 +352,7 @@
 
 :- table sanityChecks/1 as incremental.
 sanityChecks(Out) :-
+    groundSanityChecks(Out);
     insanityNoBaseConsistency(Out);
     insanityEmbeddedAndNot(Out);
     insanityConstructorAndNotConstructor(Out);
@@ -348,6 +371,11 @@
     insanityContradictoryNOTConstructor(Out);
     insanityTwoRealDestructorsOnClass(Out).
 
+groundSanityChecks(Out) :-
+    haveGround,
+
+    insanityGroundBadMerge(Out).
+
 sanityChecks :-
     sanityChecks(Out)
     ->

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 */