1 (defun check-float-file (name)
2 (with-open-file (stream name
:if-does-not-exist nil
)
4 (format t
"; Checking ~S~%" (pathname stream
))
5 ;; Ensure that we're reading the correct variant of the file
6 ;; in case there is more than one set of floating-point formats.
7 (assert (eq (read stream
) :default
))
8 (sb-kernel::with-float-traps-masked
(:overflow
:divide-by-zero
)
9 (let ((*readtable
* (copy-readtable)))
10 ;; No need to do a full-blown read-time-eval.
11 (set-dispatch-macro-character
12 #\
# #\.
(lambda (stream subchar arg
)
13 (declare (ignore subchar arg
))
14 (let ((expr (read stream t nil t
)))
17 (sb-kernel:make-single-float
(second expr
)))
19 (sb-kernel:make-double-float
(second expr
) (third expr
)))))))
20 (dolist (expr (read stream
))
21 (destructuring-bind (fun args . result
) expr
22 (let ((actual (if (eql fun
'read-from-string
)
23 (let ((*read-default-float-format
* (car args
)))
24 (multiple-value-list (apply fun
(sb-int:ensure-list
(cdr args
)))))
25 (multiple-value-list (apply fun
(sb-int:ensure-list args
))))))
26 (labels ((eqal (x y
) ; non-ideal name, but other names are also non-ideal
28 (cons (and (consp y
) (eqal (car x
) (car y
)) (eqal (cdr x
) (cdr y
))))
32 (string (string= x y
)))))
33 (unless (eqal actual result
)
35 "FLOAT CACHE LINE ~S vs COMPUTED ~S~%"
36 expr actual
)))))))))))
38 (compile 'check-float-file
)
