From 37e08830e81411ab60fbecaa0cf3dceac77f8f6c Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sat, 1 May 2004 20:43:58 +0000 Subject: [PATCH] Made the random symbol printing tests faster. --- ansi-tests/print-symbols.lsp | 63 ++++++++++++++++-------------------- 1 file changed, 27 insertions(+), 36 deletions(-) diff --git a/ansi-tests/print-symbols.lsp b/ansi-tests/print-symbols.lsp index c33c21a0..f5bffcd9 100644 --- a/ansi-tests/print-symbols.lsp +++ b/ansi-tests/print-symbols.lsp @@ -304,45 +304,36 @@ nil) (deftest print.symbol.random.3 - (let ((result nil) (count 0) (tries 0)) - (let ((pkg-name "PRINT-SYMBOL-TEST-PACKAGE")) - (when (find-package pkg-name) - (delete-package pkg-name))) - (block done - (do-all-symbols (s) - (when (symbol-package s) - (incf tries) - (let ((problem (randomly-check-readability s))) - (when problem - (setf result (nconc problem result)) - (when (= (incf count) 10) - (push (format nil "... ~A out of ~A, stopping test ..." - count tries) - result) - (return-from done))))))) - (reverse result)) + (let ((count 0) + (symbols (make-array '(1000) :fill-pointer 0 :adjustable t))) + ;; Find all symbols that have a home package, put into array SYMBOLS + (do-all-symbols (s) + (when (symbol-package s) + (vector-push-extend s symbols (array-dimension symbols 0)))) + (loop for i = (random (fill-pointer symbols)) + for s = (aref symbols i) + for tries from 1 to 10000 + for problem = (randomly-check-readability s) + nconc problem + when problem do (incf count) + while (< count 10))) nil) (deftest print.symbol.random.4 - (let ((result nil) (count 0) (tries 0)) - (let ((pkg-name "PRINT-SYMBOL-TEST-PACKAGE")) - (when (find-package pkg-name) - (delete-package pkg-name))) - (block done - (do-all-symbols (s) - (when (symbol-package s) - (incf tries) - (let ((problem - (let ((*package* (symbol-package s))) - (randomly-check-readability s)))) - (when problem - (setf result (nconc problem result)) - (when (= (incf count) 10) - (push (format nil "... ~A out of ~A, stopping test ..." - count tries) - result) - (return-from done))))))) - (reverse result)) + (let ((count 0) + (symbols (make-array '(1000) :fill-pointer 0 :adjustable t))) + ;; Find all symbols that have a home package, put into array SYMBOLS + (do-all-symbols (s) + (when (symbol-package s) + (vector-push-extend s symbols (array-dimension symbols 0)))) + (loop for i = (random (fill-pointer symbols)) + for s = (aref symbols i) + for tries from 1 to 10000 + for problem = (let ((*package* (symbol-package s))) + (randomly-check-readability s)) + nconc problem + when problem do (incf count) + while (< count 10))) nil) ;;;; Tests of printing with escaping enabled -- GitLab