From a5762b4a765b6741b56a6db0de4090cb8fddd3b0 Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sat, 22 Aug 2020 18:00:40 +0200 Subject: [PATCH] tests: 2am-ecl: implement timeouts for tests Add new macro test-with-timeout, refactor various global variables for test statistics into a struct. --- src/tests/2am.lisp | 129 ++++++++++++++++++++++++++++++++------------- 1 file changed, 92 insertions(+), 37 deletions(-) diff --git a/src/tests/2am.lisp b/src/tests/2am.lisp index 7543da6b0..b99ea2a03 100644 --- a/src/tests/2am.lisp +++ b/src/tests/2am.lisp @@ -24,21 +24,26 @@ #| to avoid conflict with the library name package 2am-ecl |# (defpackage #:2am-ecl (:use #:cl) - (:export #:test #:is #:signals #:finishes #:run #:suite)) + (:export #:test #:test-with-timeout #:is #:signals #:finishes + #:run #:suite)) (in-package #:2am-ecl) (defvar *tests* nil "A name of the default tests suite.") (defvar *suites* (make-hash-table) "A collection of test suites.") (defvar *hierarchy* (make-hash-table) "A hierarchy of test suites.") -(defvar *failures* nil) -(defvar *crashes* nil) -(defvar *test-name* nil) -(defvar *test-count* nil) -(defvar *pass-count* nil) -(defvar *fail-count* nil) +(defvar *stats* nil "Collection of test statistics.") (defvar *running* nil) +(defvar *test-name* nil) (defvar *last-fail* nil) +(defvar *default-timeout* 60.0 "Default timeout in seconds.") + +(defstruct test-stats + (failures (make-hash-table)) + (crashes 0) + (test-count 0) + (pass-count 0) + (fail-count 0)) (define-condition test-failure (simple-condition) ((test-name :initarg :name @@ -71,7 +76,12 @@ (defun shuffle (sequence) (%shuffle (map 'vector #'identity sequence))) -(defun report (test-count pass-count fail-count crashes) +(defun report (stats &aux + (test-count (test-stats-test-count stats)) + (pass-count (test-stats-pass-count stats)) + (fail-count (test-stats-fail-count stats)) + (crashes (test-stats-crashes stats)) + (failures (test-stats-failures stats))) (let ((num-check (+ pass-count fail-count))) (if *running* (format t "~&Did ~s test~:p (~s crashed), ~s check~:p.~%" test-count crashes num-check) @@ -92,16 +102,12 @@ (format t " CRASH [~A]: " (type-of fail))) (format t "~A~%" fail)) (format t "~&--------------------------------~%")) - *failures*))) + failures))) (defun %run (fn) - (let ((*test-count* 0) - (*pass-count* 0) - (*fail-count* 0) - (*failures* (make-hash-table)) - (*crashes* 0)) + (let ((*stats* (make-test-stats))) (multiple-value-prog1 (funcall fn) - (report *test-count* *pass-count* *fail-count* *crashes*)))) + (report *stats*)))) (defun %run-suite (name) (let ((visited nil) @@ -131,41 +137,90 @@ (map nil #'funcall (shuffle tests))))))) (values)) -(defun call-test (fn) - (format t "~&Running test ~s " *test-name*) - (finish-output) - (if *running* - (handler-case - (progn (incf *test-count*) - (funcall fn)) - (serious-condition (c) - (write-char #\X) - (incf *crashes*) - (push c (gethash *test-name* *failures*)))) - (%run fn)) - (values)) +(defun call-test (name fn) + (let ((*test-name* name)) + (format t "~&Running test ~s " *test-name*) + (finish-output) + (if *running* + (handler-case + (progn (incf (test-stats-test-count *stats*)) + (funcall fn)) + (serious-condition (c) + (write-char #\X) + (incf (test-stats-crashes *stats*)) + (push c (gethash *test-name* (test-stats-failures *stats*))))) + (%run fn)) + (values))) (defmacro test (name &body body) - "Define a test function and add it to `*tests*'." `(progn (defun ,name () - (let ((*test-name* ',name)) - (call-test (lambda () ,@body)))) + (call-test ',name (lambda () ,@body))) (pushnew ',name (gethash *tests* *suites*)) ',name)) +(defun kill-processes (process-list &optional original) + "Kills a list of processes, which may be the difference between two lists." + (let ((process-list (set-difference process-list original))) + (when (member mp:*current-process* process-list) + (error "Found myself in the kill list")) + (mapc #'mp:process-kill process-list) + process-list)) + +#+threads +(defun call-test-with-timeout (name timeout fn) + (let* ((all-processes (mp:all-processes)) + (finished nil) + (runner (mp:process-run-function + "runner" + #'(lambda (stats running) + (let ((*stats* stats) + (*running* running)) + (call-test name fn) + (setf finished t))) + *stats* *running*))) + (loop with *test-name* = name + with timestep = 0.2 + for time from 0.0 upto timeout by timestep + do (if finished + (return) + (sleep timestep)) + finally (mp:process-kill runner) + (failed (make-condition 'test-failure + :name name + :format-control "Timeout after ~A seconds" + :format-arguments (list timeout))) + (return-from call-test-with-timeout)) + (mp:process-join runner) + (let ((leftovers (kill-processes (mp:all-processes) all-processes))) + (when leftovers + (format t "~%;;; Stray processes: ~A~%" leftovers))))) + +#+threads +(defmacro test-with-timeout (name-and-timeout &body body) + (let (name timeout) + (if (listp name-and-timeout) + (setf name (first name-and-timeout) + timeout (second name-and-timeout)) + (setf name name-and-timeout + timeout '*default-timeout*)) + `(progn + (defun ,name () + (call-test-with-timeout ',name ,timeout (lambda () ,@body))) + (pushnew ',name (gethash *tests* *suites*)) + ',name))) + (defun passed () (write-char #\.) - (when *pass-count* - (incf *pass-count*)) + (when *stats* + (incf (test-stats-pass-count *stats*))) T) (defun failed (c) (write-char #\f) - (when *fail-count* - (incf *fail-count*)) - (when *failures* - (push c (gethash *test-name* *failures*))) + (when *stats* + (incf (test-stats-fail-count *stats*)) + (push c (gethash *test-name* (test-stats-failures *stats*)))) (setf *last-fail* c) nil)