Skip to content

Commit

Permalink
proof-stat: add batch mode and TAP support
Browse files Browse the repository at this point in the history
  • Loading branch information
hendriktews committed Apr 5, 2024
1 parent c1a4cc6 commit 4b02000
Show file tree
Hide file tree
Showing 2 changed files with 67 additions and 30 deletions.
4 changes: 2 additions & 2 deletions ci/simple-tests/coq-test-proof-stat.el
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,7 @@ Test that the report buffer contains the expected output."
(find-file "proof_stat.v")

;; run check on file where all errors are in opaque parts
(proof-check-proofs)
(proof-check-proofs nil)

;; the result buffer should exist
(should (buffer-live-p (get-buffer "*proof-check-report*")))
Expand Down Expand Up @@ -74,7 +74,7 @@ Check that `proof-check-proofs' signals an error with the expected message."
;; proof-check-proofs should abort now with an error
(condition-case err-desc
(progn
(proof-check-proofs)
(proof-check-proofs nil)
;; Still here? Make test fail!
(should nil))
(error
Expand Down
93 changes: 65 additions & 28 deletions generic/pg-user.el
Original file line number Diff line number Diff line change
Expand Up @@ -603,14 +603,20 @@ last use time, to discourage saving these into the users database."
;; Check validity of proofs
;;

(defun proof-check-report (proof-results)
(defun proof-check-report (proof-results tap batch)
"Report `proof-check-proofs' results in PROOF-RESULTS in special buffer.
Report the results of `proof-check-proofs' in buffer
`proof-check-report-buffer' in human readable form."
`proof-check-report-buffer' in human readable form or, if TAP is
not nil, in test anything protocol (TAP). If BATCH is not nil,
report the results via message, such that they appear on stdout
when Emacs runs in batch mode or, when BATCH is a string, append
the results to the file denoted by BATCH."
(let* ((ok-fail (seq-group-by #'car proof-results))
(frmt " %-4s %s")
(frmt-face (propertize frmt 'face 'error))
(count 1)
coq-proj-dir src-file)

;; determine a relative file name for current buffer
(when buffer-file-name
(setq coq-proj-dir (locate-dominating-file buffer-file-name
Expand All @@ -622,25 +628,43 @@ Report the results of `proof-check-proofs' in buffer
;; generate header
(with-current-buffer (get-buffer-create proof-check-report-buffer)
(erase-buffer)
(insert
(propertize (concat "Proof check results for " src-file) 'face 'bold)
"\n\n")
(insert
(format
(propertize "%d opaque proofs recognized: %d successful " 'face 'bold)
(length proof-results)
(length (cdr (assoc t ok-fail)))))
(insert (format (propertize "%d FAILING" 'face 'error 'face 'bold)
(length (cdr (assoc nil ok-fail)))))
(insert "\n\n")
;; generate actual proof results
(if tap
(insert (format "TAP version 14\n1..%d\n" (length proof-results)))
;; human output
(insert
(propertize (concat "Proof check results for " src-file) 'face 'bold)
"\n\n")
(insert
(format
(propertize "%d opaque proofs recognized: %d successful " 'face 'bold)
(length proof-results)
(length (cdr (assoc t ok-fail)))))
(insert (format (propertize "%d FAILING" 'face 'error 'face 'bold)
(length (cdr (assoc nil ok-fail)))))
(insert "\n\n"))
(dolist (pr proof-results)
(insert (format (if (car pr) frmt frmt-face)
(if (car pr) "OK " "FAIL")
(cadr pr)))
(insert "\n"))
(goto-char (point-min))
(display-buffer (current-buffer)))))
(if tap
(progn
(insert (format "%sok %d - %s\n"
(if (car pr) "" "not ")
count
(cadr pr)))
(setq count (1+ count)))
;; human readable
(insert (format (if (car pr) frmt frmt-face)
(if (car pr) "OK " "FAIL")
(cadr pr)))
(insert "\n")))
(if batch
(progn
(insert "\n\n")
(if (stringp batch)
(append-to-file (point-min) (point-max) batch)
(message "%s"
(buffer-substring-no-properties
(point-min) (point-max)))))
(goto-char (point-min))
(display-buffer (current-buffer))))))

(defun proof-check-chunks (chunks)
"Worker function for `proof-check-proofs for processing CHUNKS.
Expand Down Expand Up @@ -727,28 +751,41 @@ as reported by `proof-get-proof-info-fn'."
(setq chunks (cdr chunks))))
(nreverse proof-results)))

(defun proof-check-proofs ()
"Generate overview about valid and invalid proofs in current buffer.
(defun proof-check-proofs (tap &optional batch)
"Generate an overview about valid and invalid proofs.
This command completely processes the current buffer and
generates an overview in the `proof-check-report-buffer' about
all the opaque proofs in it and whether their proof scripts are
valid or invalid.
generates an overview about all the opaque proofs in it and
whether their proof scripts are valid or invalid.
This command makes sense for a development process where invalid
proofs are permitted and vos compilation and the omit proofs
feature (see `proof-omit-proofs-configured') are used to work at
the most interesting or challenging point instead of on the first
invalid proof.
Argument TAP, which can be set by a prefix argument, controls the
form of the generated overview. Nil, without prefix, gives an
human readable overview, otherwise it's test anything
protocol (TAP). Argument BATCH controls where the overview goes
to. If nil, or in an interactive call, the overview appears in
`proof-check-report-buffer'. If BATCH is a string, it should be a
filename and the overview is appended there. Otherwise the
overview is output via `message' such that it appears on stdout
when this command runs in batch mode.
In the same way as the omit-proofs feature, this command only
tolerates errors inside scripts of opaque proofs. Any other error
is reported to the user without generating an overview. The
overview only contains those names of theorems whose proofs
scripts are classified as opaque by the omit-proofs feature. For
Coq for instance, among others, proof scripts terminated with
'Defined' are not opaque and do not appear in the generated
overview."
(interactive)
overview.
Note that this command does not (re-)compile required files.
Files must be required before running this commands, for instance
by asserting all require commands beforehand."
(interactive "P")
(unless (and proof-omit-proofs-configured
proof-get-proof-info-fn
proof-retract-command-fn)
Expand All @@ -773,7 +810,7 @@ overview."
nil "proof-check: first chunk cannot be a proof")
(setq proof-results (proof-check-chunks chunks))
(proof-shell-exit t)
(proof-check-report proof-results)))
(proof-check-report proof-results tap batch)))



Expand Down

0 comments on commit 4b02000

Please sign in to comment.