extract ordering comparator to tg-utils::ordering-comparator and use …

…it in several reports

reporting/compiler-diff.lisp

@@ -34,16 +34,9 @@ reports-generated/<REPORT-FILE>."
                                   :test #'equal
                                   :key (lambda (result)
                                          (list (libname result) (result-spec result))))))
-    ;; We can not be sure that (string< lisp1 lisp2) == t,
-    ;; so create another comparator function whch guarantees that
-    ;; the lisp1 is always in the left column. The same for lib-worlds.
-    (flet ((make-comparator (ordering-list)
-             (lambda (val-a val-b)
-               (< (position val-a ordering-list :test #'string=)
-                  (position val-b ordering-list :test #'string=)))))
-      (print-pivot report-file
-                   diff
-                   :rows '((libname string<))
-                   :cols `((lib-world ,(make-comparator (list quicklisp1 quicklisp2)))
-                           (lisp ,(make-comparator (list lisp1 lisp2))))
-                   :cell-printer #'results-cell-printer))))
+    (print-pivot report-file
+                 diff
+                 :rows '((libname string<))
+                 :cols `((lib-world ,(tg-utils::ordering-comparator (list quicklisp1 quicklisp2) #'string=))
+                         (lisp ,(tg-utils::ordering-comparator (list lisp1 lisp2) #'string=)))
+                 :cell-printer #'results-cell-printer)))

reporting/quicklisp-diff.lisp

@@ -75,16 +75,10 @@ Returns test part of the result-spec."
                                     :key (lambda (result)
                                            (list (libname result)
                                                  (lisp result)
-                                                 (result-spec result))))))
-         ;; comparator function whch guarantees that
-         ;; the old-quicklisp is always in the left column.
-         (two-lib-worlds (list old-quicklisp new-quicklisp))
-         (lib-world-comparator (lambda (lib-world-a lib-world-b)
-                                 (< (position lib-world-a two-lib-worlds :test #'string=)
-                                    (position lib-world-b two-lib-worlds :test #'string=)))))
+                                                 (result-spec result)))))))
     (my-time ("print-pivot...")
       (print-pivot report-file
                    diff
                    :rows '((lisp string<) (libname string<))
-                   :cols `((lib-world ,lib-world-comparator))
+                   :cols `((lib-world ,(tg-utils::ordering-comparator (list old-quicklisp new-quicklisp) #'string=)))
                    :cell-printer #'results-cell-printer))))

reporting/quicklisp-diff2.lisp

@@ -56,5 +56,5 @@
   (print-pivot report-file
                (quicklisp-diff-items all-results old-quicklisp new-quicklisp)
                :rows '((libname string<) (lisp string<))
-               :cols '((lib-world string<))
+               :cols `((lib-world ,(tg-utils::ordering-comparator (list old-quicklisp new-quicklisp) #'string=)))
                :cell-printer #'results-cell-printer))

utils/utils.lisp

@@ -86,6 +86,18 @@
   '((:A 1 :B "x") (:A 2 :B "y") (:A 2 :B "y") (:A 3 :B "z")))
 |#
 
+(defun ordering-comparator (ordering-list test)
+  (lambda (val-a val-b)
+    (< (position val-a ordering-list :test test)
+       (position val-b ordering-list :test test))))
+
+(let ((cmp (ordering-comparator '("a" "b" "c") #'string=)))
+  (assert (funcall cmp "a" "b"))
+  (assert (funcall cmp "b" "c"))
+  (assert (funcall cmp "a" "c"))
+  (assert (not (funcall cmp "b" "a")))
+  (assert (not (funcall cmp "b" "b"))))
+
 (defun plist-getter (prop)
   #'(lambda (plist)
       (getf plist prop)))