<commit_before>(in-package :com.superadditive.incf-cl)

;;; Copyright (c) 2007 <NAME> <<EMAIL>>
;;; 
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;; 
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;; 
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.

(define-condition doctest-failure ()
  ((sexpr :initarg :sexpr :reader sexpr)
   (actual-values :initarg :actual-values :reader actual-values)
   (expected-values :initarg :expected-values :reader expected-values))
  (:report (lambda (condition stream)
             (format stream "~s => ~{~a~^ ~} /= ~{~a~^ ~}"
                     (sexpr condition)
                     (actual-values condition)
                     (expected-values condition)))))

(defun symbol-function-or-nil (symbol)
  ;; Taken verbatim from the Hyperspec.
  (if (and (fboundp symbol)
           (not (macro-function symbol))
           (not (special-operator-p symbol)))
      (symbol-function symbol)
      nil))

(defun test-docstring (documentation)
  "Returns T if the first doctest found in DOCUMENTATION passes,
signals DOCTEST-FAILURE otherwise."
  (with-input-from-string (input-stream documentation)
    (labels ((aux (_)
               (declare (ignore _))
               (read input-stream nil input-stream)))
      (let* ((sexpr (read input-stream))
             (actual-values (multiple-value-list (eval sexpr)))
             (expected-values (mapcar #'aux actual-values))
             (eof-pos (position-if (curry #'eq input-stream)
                                   expected-values)))
        (if (every #'equalp actual-values expected-values)
            t
            (signal 'doctest-failure
                    :sexpr sexpr
                    :actual-values actual-values
                    :expected-values (if eof-pos
                                         (take eof-pos expected-values)
                                         expected-values)))))))

(defun test-function (package-name function stream)
  "Returns T if every test written in FUNCTION's docstring passes, NIL
otherwise."
  (let* ((passed-p t)
         (documentation (documentation function 'function))
         (re (concatenate 'string "[ \t]*" package-name "> "))
         (matches (cl-ppcre:all-matches re documentation)))
    (loop for start in (rest matches) by #'cddr do
         (handler-case
             (when (test-docstring (subseq documentation start))
               (princ #\. stream))
           (end-of-file (_)
             (declare (ignore _))
             (format stream "~%MALFORMED TEST: ~a~%" function))
           (doctest-failure (condition)
             (format stream "~%FAILED TEST: ~a~%~a~%" function condition)
             (setf passed-p nil)))
         finally (return passed-p))))

(defun doctest (package &optional (stream *standard-output*))
  "Tests the docstrings of each exported function in PACKAGE and
outputs the results to STREAM."
  (let ((passed-p t)
        (*package* (find-package package)))
    (do-external-symbols (symbol package passed-p)
      (let ((function (symbol-function-or-nil symbol)))
        (when function
          (unless (test-function (symbol-name package) function stream)
            (setf passed-p nil)))))))<commit_msg>Rewrote doctest's docstring.<commit_after>(in-package :com.superadditive.incf-cl)

;;; Copyright (c) 2007 <NAME> <<EMAIL>>
;;; 
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;; 
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;; 
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.

(define-condition doctest-failure ()
  ((sexpr :initarg :sexpr :reader sexpr)
   (actual-values :initarg :actual-values :reader actual-values)
   (expected-values :initarg :expected-values :reader expected-values))
  (:report (lambda (condition stream)
             (format stream "~s => ~{~a~^ ~} /= ~{~a~^ ~}"
                     (sexpr condition)
                     (actual-values condition)
                     (expected-values condition)))))

(defun symbol-function-or-nil (symbol)
  ;; Taken verbatim from the Hyperspec.
  (if (and (fboundp symbol)
           (not (macro-function symbol))
           (not (special-operator-p symbol)))
      (symbol-function symbol)
      nil))

(defun test-docstring (documentation)
  "Returns T if the first doctest found in DOCUMENTATION passes,
signals DOCTEST-FAILURE otherwise."
  (with-input-from-string (input-stream documentation)
    (labels ((aux (_)
               (declare (ignore _))
               (read input-stream nil input-stream)))
      (let* ((sexpr (read input-stream))
             (actual-values (multiple-value-list (eval sexpr)))
             (expected-values (mapcar #'aux actual-values))
             (eof-pos (position-if (curry #'eq input-stream)
                                   expected-values)))
        (if (every #'equalp actual-values expected-values)
            t
            (signal 'doctest-failure
                    :sexpr sexpr
                    :actual-values actual-values
                    :expected-values (if eof-pos
                                         (take eof-pos expected-values)
                                         expected-values)))))))

(defun test-function (package-name function stream)
  "Returns T if every test written in FUNCTION's docstring passes, NIL
otherwise."
  (let* ((passed-p t)
         (documentation (documentation function 'function))
         (re (concatenate 'string "[ \t]*" package-name "> "))
         (matches (cl-ppcre:all-matches re documentation)))
    (loop for start in (rest matches) by #'cddr do
         (handler-case
             (when (test-docstring (subseq documentation start))
               (princ #\. stream))
           (end-of-file (_)
             (declare (ignore _))
             (format stream "~%MALFORMED TEST: ~a~%" function))
           (doctest-failure (condition)
             (format stream "~%FAILED TEST: ~a~%~a~%" function condition)
             (setf passed-p nil)))
         finally (return passed-p))))

(defun doctest (package &optional (stream *standard-output*))
  "Returns T if the doctests present in each exported function in
PACKAGE are correct, NIL otherwise.  It outputs the results to
STREAM."
  (let ((passed-p t)
        (*package* (find-package package)))
    (do-external-symbols (symbol package passed-p)
      (let ((function (symbol-function-or-nil symbol)))
        (when function
          (unless (test-function (symbol-name package) function stream)
            (setf passed-p nil)))))))
{'fraction_non_alphanumeric': 0.11490683229813664, 'fraction_numerical': 0.0009555661729574773, 'mean_word_length': 2.595105195362817, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 13, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 10, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '169557', 'n_tokens_mistral': 2319, 'n_tokens_neox': 2204, 'n_words': 820}