;;; ----------------------------------------------------------------------
;;; File: ui-tests.lisp
;;; John, Bremen, Feb00
;;;
;;; just ui access to the consistency tests.... put the flags for various
;;; tests in a separate package here rather than anything fancy so that
;;; they do not appear as curious globals anywhere else...
;;;
;;; 4.0  own notify-user
;;; 3.2+ uses positioned accepting-values macro
;;; ----------------------------------------------------------------------

(cl:defpackage "KPML-TEST-FLAGS"
  (:use "COMMON-LISP" "KPML")
  (:nicknames "KTF"))

(in-package "KTF")
(defvar all-languages? nil)
(defvar file-name "/tmp/check.txt")
(defvar uit T)
(defvar uot T)
(defvar evft T)
(defvar expandt T)
(defvar dolt T)
(defvar cds T)
(defvar iiuc T)
(defvar ids T)
(defvar ois T)
(defvar ac T)
(defvar ls nil)
(defvar ra nil)

(in-package "KPML")

(defun SELECT-CONSISTENCY-CHECKS ()
  (let ((stream 
	 (clim::frame-top-level-sheet clim:*application-frame*))
        )
    (restart-case
      (kpml-i::positioned-accepting-values
	(stream :own-window kpml-i::*own-window*
                :x-position 20 ;;; (first kpml-i::*confirmation-popups-xy*)
                :y-position 20 ;;; (second kpml-i::*confirmation-popups-xy*)
		:scroll-bars :horizontal
		:resynchronize-every-pass t
		:label "Consistency Checks Selector" 
                :exit-boxes '((:exit "Run checks")(:abort "Cancel")))
      
      (kpml-i::hd-accepts ktf::file-name 'clim:pathname "File for report" clim:+textual-dialog-view+)
      (kpml-i::on-or-off ktf::all-languages? "All languages?")
      (format stream "~%         ")
      
      (clim:formatting-table (stream)
        (clim:formatting-row (stream)
	  (clim:formatting-cell (stream)
            (kpml-i-terpri stream)
            (format stream "~%.... paradigmatic tests...~%")
            (kpml-i::on-or-off ktf::uit "Unreachable inputs test")
            (kpml-i::on-or-off ktf::uot "Unreachable outputs test")
            (kpml-i::on-or-off ktf::evft "Void features test"))
          
          (clim:formatting-cell (stream)
            (format stream "~2%.... syntagmatic tests...~%")
            (kpml-i::on-or-off ktf::expandt "Expand+Classify/Conflate/Lexify tests")
            (kpml-i::on-or-off ktf::dolt "Default ordering loops tests")))

        (clim:formatting-row (stream)
	  (clim:formatting-cell (stream)
            (kpml-i-terpri stream)
            (format stream "~2%.... resource surveys...~%")
            (kpml-i::on-or-off ktf::cds "Chooser definitions")
            (kpml-i::on-or-off ktf::ac  "Chooser feature usage")
            (kpml-i::on-or-off ktf::ls  "Lexicon items and used classes")
            )
	  (clim:formatting-cell (stream)
            (kpml-i::on-or-off ktf::iiuc "Unbound inquiry implementations")
            (kpml-i::on-or-off ktf::ois "Extent of implemented inquiries")
            (kpml-i::on-or-off ktf::ids "Inquiry definitions")
            (kpml-i::on-or-off ktf::ra "Region assignments")
            )))
      (kpml-i-terpri stream))
      (abort ()
             (return-from SELECT-CONSISTENCY-CHECKS nil)))

    ;; Made a selection, now do the selected tests...
    (macrolet ((do-test (var test-function string)
                  `(when ,var 
                     (format stream ,(concatenate 'string "~%  Testing: " string "..."))
                     (if (,test-function)
                         (format stream "... !! Possible problem found.")
                       (format stream "... OK.")))))
      (format *standard-output* "~%RUNNING TESTS....")
      (when ktf::file-name
        (macrolet 
            ((do-tests ()
               '(let ((*standard-output* output-stream))
                  (reset-system-network curlan)
                  (create-valid-lexical-feature-list curlan)
                  (create-list-of-test-alls)
                  (kpml-i::own-notify-user              ;; 4.0
		   stream
                   (with-output-to-string (stream)
                     (format stream "~% Test results (~A)...~%" curlan)
                     (do-test ktf::uit unreachable-inputs-test "unreachable inputs")
                     (do-test ktf::uot unreachable-outputs-test "unreachable outputs")
                     (do-test ktf::evft excess-void-features-test "void features")
                     (do-test ktf::expandt expand-classify-test "potential expand and classify conflicts")
                     (do-test ktf::expandt Expand-Out-Classify-Test 
                              "potential expand and outclassify conflicts")
                     (do-test ktf::expandt Expand-Conflate-Test "potential expand and conflation conflicts")
                     (do-test ktf::expandt Expand-Lexify-Test "potential expand and lexify conflicts")
                     (do-test ktf::expandt Expand-Preselect-Test 
                              "potential expand and preselection conflicts")
                     (do-test ktf::cds chooser-definition-survey "chooser definitions")
                     (do-test ktf::ac analyze-choosers "chooser feature usage")
                     (do-test ktf::dolt default-ordering-loops-test "default order loops")
                     (do-test ktf::iiuc inquiry-implementations-unbound-check "inquiry implementations bound")
                     (do-test ktf::ids inquiry-definition-survey "inquiry definitions")
                     (do-test ktf::ois operator-implementation-survey "operator survey")
                     (do-test ktf::ls lexicon-survey  "lexicon survey")
                     (do-test ktf::ra region-assignment-survey "region-metafunction assignment")
                     (format stream "~2%Details in ~A" file-name)
                     )))))
          (unwind-protect
              (let ((file-name (merge-pathnames 
                                ktf::file-name
                                (user-homedir-pathname))))
                (with-open-file 
		    (output-stream  file-name  
				    :direction :output
				    :if-exists :new-version)
                  (if ktf::all-languages?
                      (loop for curlan in all_languages
                            do
                            (format output-stream "~% ====== Tests for language: ~A at: ~A" 
                                    curlan (kpml::time-stamp))
		            (do-tests))
                    (do-tests))
                  )
                )))))))
          
