From a8ca88f86ab083f135c2e10820a32ab815ba44a1 Mon Sep 17 00:00:00 2001
From: "Edward J. Schwartz" <eschwartz@cert.org>
Date: Thu, 17 Nov 2022 10:31:52 -0500
Subject: [PATCH 1/2] Start to add ground truth "sanity checks"

---
 share/prolog/oorules/insanity.pl | 28 ++++++++++++++++++++++++++++
 share/prolog/oorules/ooprolog.pl | 15 +++++++++++----
 2 files changed, 39 insertions(+), 4 deletions(-)

diff --git a/share/prolog/oorules/insanity.pl b/share/prolog/oorules/insanity.pl
index b99cef92..f4c259c2 100644
--- a/share/prolog/oorules/insanity.pl
+++ b/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)
     ->
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 */

From be4002c67f966d629fc34a3ee2d989888ae43b3c Mon Sep 17 00:00:00 2001
From: "Edward J. Schwartz" <eschwartz@cert.org>
Date: Thu, 17 Nov 2022 14:16:58 -0500
Subject: [PATCH 2/2] VFTable Belongs check.  Fix groundTruth bug.

---
 share/prolog/oorules/insanity.pl | 16 +++++++++++++++-
 1 file changed, 15 insertions(+), 1 deletion(-)

diff --git a/share/prolog/oorules/insanity.pl b/share/prolog/oorules/insanity.pl
index f4c259c2..66792e82 100644
--- a/share/prolog/oorules/insanity.pl
+++ b/share/prolog/oorules/insanity.pl
@@ -4,6 +4,7 @@
 % ============================================================================================
 
 :- table haveGround/0 as opaque.
+:- multifile groundTruth/9.
 haveGround :- groundTruth(_, _, _, _, _, _, _, _, _), !.
 
 % If we have ground truth, did we merge two different classes together?
@@ -24,6 +25,18 @@
         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.
@@ -374,7 +387,8 @@
 groundSanityChecks(Out) :-
     haveGround,
 
-    insanityGroundBadMerge(Out).
+    (insanityVFTableDoesntBelong(Out);
+     insanityGroundBadMerge(Out)).
 
 sanityChecks :-
     sanityChecks(Out)