Commit b7ed600e authored by pfdietz's avatar pfdietz

Add randomized tests for printing integers, ratios.

parent a6e24013
......@@ -10,4 +10,5 @@
(load "copy-pprint-dispatch.lsp")
(load "print-integers.lsp")
(load "print-ratios.lsp")
......@@ -264,7 +264,10 @@
(concatenate 'string "#36r-" (make-string 200 :initial-element #\Z))
(*print-radix* t) (*print-base* 36))
(deftest print.integers.random
(loop for i from 1 to 10000
for numbits = (random 40)
for bound = (ash 1 numbits)
for r = (- (random (+ bound bound)) bound)
nconc (randomly-check-readability r))
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Mon Mar 1 22:03:58 2004
;;;; Contains: Tests for printing ratios
(in-package :cl-test)
(deftest print.ratios.random
(loop for i from 1 to 1000
for numbits = (1+ (random 40))
for bound = (ash 1 numbits)
for num = (- (random (+ bound bound)) bound)
for denom = (1+ (random bound))
for r = (/ num denom)
nconc (randomly-check-readability r))
......@@ -13,3 +13,52 @@
(with-output-to-string (*standard-output*) (prin1 ,form))))
;;; Function to test readable of printed forms, under random settings
;;; of various printer control variables.
;;; Return NIL if obj printed and read properly, or a list containing
;;; the object and the printer variable bindings otherwise. They key
;;; argument TEST is used to compared the reread object and obj.
(defun randomly-check-readability (obj &key (test #'equal))
;; Generate random printer-control values
(let ((*print-array* (coin))
(*print-base* (+ 2 (random 34)))
(*print-radix* (coin))
(*print-case* (random-from-seq #(:upcase :downcase :capitalize)))
(*print-circle* (coin))
(*print-escape* (coin))
(*print-gensym* (coin))
(*print-level* (random 50))
(*print-length* (random 50))
(*print-lines* (random 50))
(*print-miser-width* (and (coin) (random 100)))
(*print-pretty* (coin))
(*print-right-margin* (and (coin) (random 100)))
(*print-readably* t)
(let* ((str (with-output-to-string (s) (write obj :stream s)))
(obj2 (let ((*read-base* *print-base*))
(read-from-string str)
(reader-error () :error)))))
(unless (funcall test obj obj2)
(list obj obj2
(list '*print-array* *print-array*)
(list '*print-base* *print-base*)
(list '*print-radix* *print-radix*)
(list '*print-case* *print-case*)
(list '*print-circle* *print-circle*)
(list '*print-escape* *print-escape*)
(list '*print-gensym* *print-gensym*)
(list '*print-level* *print-level*)
(list '*print-length* *print-length*)
(list '*print-lines* *print-lines*)
(list '*print-miser-width* *print-miser-width*)
(list '*print-pretty* *print-pretty*)
(list '*print-right-margin* *print-right-margin*))))))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment