diff options
author | sterni <sternenseemann@systemli.org> | 2023-05-09T17·08+0200 |
---|---|---|
committer | sterni <sternenseemann@systemli.org> | 2023-05-16T16·25+0000 |
commit | a4d740af2ec82d24f513ca060ada07c8842ab764 (patch) | |
tree | d24ea2f595c2d7013e9c3a3bc650cb331b248387 | |
parent | e815b680c0d7fdd99c0bdb4b198e3f4c591997b8 (diff) |
refactor(3p/lisp/mime4cl/test): create one test case per sample file r/6147
Since rt.lisp seems to start tests in parallel, the informational output about which sample file is being tested gets mangled in all sorts of ways. The solution is to just loop over the sample files outside a test and schedule a single test case per sample file from there. Change-Id: I4494e4a526ce6d92a298cf7daf06c8013c7ca605 Reviewed-on: https://cl.tvl.fyi/c/depot/+/8569 Reviewed-by: sterni <sternenseemann@systemli.org> Tested-by: BuildkiteCI
Diffstat (limited to '')
-rw-r--r-- | third_party/lisp/mime4cl/test/mime.lisp | 26 | ||||
-rw-r--r-- | third_party/lisp/mime4cl/test/rt.lisp | 20 |
2 files changed, 24 insertions, 22 deletions
diff --git a/third_party/lisp/mime4cl/test/mime.lisp b/third_party/lisp/mime4cl/test/mime.lisp index 2b87c9e5a4ff..dbd1dd996dcc 100644 --- a/third_party/lisp/mime4cl/test/mime.lisp +++ b/third_party/lisp/mime4cl/test/mime.lisp @@ -27,17 +27,15 @@ *load-pathname* #P""))) -(deftest mime.1 - (loop - for f in (directory (make-pathname :defaults *samples-directory* - :name :wild - :type "msg")) - do - (format t "~A:~%" f) - (finish-output) - (let* ((orig (mime-message f)) - (dup (mime-message (with-output-to-string (out) (encode-mime-part orig out))))) - (unless (mime= orig dup) - (return nil))) - finally (return t)) - t) +(loop + for f in (directory (make-pathname :defaults *samples-directory* + :name :wild + :type "msg")) + for i from 1 + do + (add-test (intern (format nil "MIME.~A" i)) + `(let* ((orig (mime-message ,f)) + (dup (mime-message + (with-output-to-string (out) (encode-mime-part orig out))))) + (mime= orig dup)) + t)) diff --git a/third_party/lisp/mime4cl/test/rt.lisp b/third_party/lisp/mime4cl/test/rt.lisp index 06160debbe9b..3f3aa5c56cd3 100644 --- a/third_party/lisp/mime4cl/test/rt.lisp +++ b/third_party/lisp/mime4cl/test/rt.lisp @@ -1,5 +1,6 @@ #|----------------------------------------------------------------------------| | Copyright 1990 by the Massachusetts Institute of Technology, Cambridge MA. | + | Copyright 2023 by the TVL Authors | | | | Permission to use, copy, modify, and distribute this software and its | | documentation for any purpose and without fee is hereby granted, provided | @@ -20,10 +21,10 @@ |----------------------------------------------------------------------------|# (defpackage #:regression-test - (:nicknames #:rtest #-lispworks #:rt) + (:nicknames #:rtest #-lispworks #:rt) (:use #:cl) (:export #:*do-tests-when-defined* #:*test* #:continue-testing - #:deftest #:do-test #:do-tests #:get-test #:pending-tests + #:deftest #:add-test #:do-test #:do-tests #:get-test #:pending-tests #:rem-all-tests #:rem-test) (:documentation "The MIT regression tester with pfdietz's modifications")) @@ -86,25 +87,28 @@ (defmacro deftest (name form &rest values) `(add-entry '(t ,name ,form .,values))) +(defun add-test (name form &rest values) + (funcall #'add-entry (append (list 't name form) values))) + (defun add-entry (entry) (setq entry (copy-list entry)) (do ((l *entries* (cdr l))) (nil) (when (null (cdr l)) (setf (cdr l) (list entry)) (return nil)) - (when (equal (name (cadr l)) + (when (equal (name (cadr l)) (name entry)) (setf (cadr l) entry) (report-error nil - "Redefining test ~:@(~S~)" - (name entry)) + "Redefining test ~:@(~S~)" + (name entry)) (return nil))) (when *do-tests-when-defined* (do-entry entry)) (setq *test* (name entry))) (defun report-error (error? &rest args) - (cond (*debug* + (cond (*debug* (apply #'format t args) (if error? (throw '*debug* nil))) (error? (apply #'error args)) @@ -184,7 +188,7 @@ (setf (pend entry) (or aborted (not (equalp-with-case r (vals entry))))) - + (when (pend entry) (let ((*print-circle* *print-circle-on-failure*)) (format s "~&Test ~:@(~S~) failed~ @@ -210,7 +214,7 @@ (setf (pend entry) t)) (if (streamp out) (do-entries out) - (with-open-file + (with-open-file (stream out :direction :output) (do-entries stream)))) |