Commit d0758610 authored by Raymond Toy's avatar Raymond Toy
Browse files

Merge branch 'issue-16-use-named-readtables' into 'master'

Fix #16: Use named-readtables

Closes #16

See merge request !14
parents 3373bd8e c9fb84c8
Pipeline #2323 passed with stage
in 1 minute and 49 seconds
variables:
GIT_SUBMODULE_STRATEGY: recursive
download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2020/04"
version: "2020-04-x86"
......
[submodule "melisgl-named-readtables"]
path = melisgl-named-readtables
url = https://gitlab.common-lisp.net/rtoy/melisgl-named-readtables
Subproject commit 070193f0661a97751160e24938fc28eee30fbf6c
......@@ -29,6 +29,11 @@
(defpackage #:oct-system
(:use #:cl #:asdf))
(pushnew (merge-pathnames "./melisgl-named-readtables/")
asdf:*central-registry*)
(require :named-readtables)
(in-package #:oct-system)
(asdf:defsystem oct
......@@ -81,9 +86,21 @@
(:file "rt-tests")))))
(defmethod perform ((op test-op) (c (eql (asdf:find-system :oct/tests))))
(let* ((rt-package (find-package "RT"))
(pass (funcall (intern "DO-TESTS" rt-package)))
(unexpected-failures (symbol-value (find-symbol "*UNEXPECTED-FAILURES*" rt-package)))
(unexpected-successes (symbol-value (find-symbol "*UNEXPECTED-SUCCESSES*" rt-package))))
(or (and (null unexpected-failures) (null unexpected-successes))
(error "TEST-OP failed for OCT-TESTS"))))
;; Set the initial random state when running tests so that we get
;; consistent test results between runs. Currently only works with
;; cmucl.
;;
;; TODO: Figure out how to initialize the random state to a known
;; value for other lisps.
(let* ((*random-state*
#+cmucl
(kernel::make-random-object :state (kernel:init-random-state))
#-cmucl
(make-random-state nil)))
(format t "Test random-state ~A~%" *random-state*)
(let* ((rt-package (find-package "RT"))
(pass (funcall (intern "DO-TESTS" rt-package)))
(unexpected-failures (symbol-value (find-symbol "*UNEXPECTED-FAILURES*" rt-package)))
(unexpected-successes (symbol-value (find-symbol "*UNEXPECTED-SUCCESSES*" rt-package))))
(or (and (null unexpected-failures) (null unexpected-successes))
(error "TEST-OP failed for OCT-TESTS")))))
......@@ -237,4 +237,6 @@
;; CMUCL supports infinities.
#+cmu
(:export #:+quad-double-float-positive-infinity+
#:+quad-double-float-negative-infinity+))
#:+quad-double-float-negative-infinity+)
;;
(:export #:oct-readtable))
......@@ -25,8 +25,7 @@
(in-package #:oct)
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *readtable* *oct-readtable*))
(named-readtables:in-readtable oct-readtable))
(defmethod add1 ((a qd-complex))
(make-instance 'qd-complex
......
......@@ -24,8 +24,7 @@
(in-package #:oct)
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *readtable* *oct-readtable*))
(named-readtables:in-readtable oct-readtable))
(declaim (inline descending-transform ascending-transform))
......
......@@ -25,8 +25,7 @@
(in-package #:oct)
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *readtable* *oct-readtable*))
(named-readtables:in-readtable oct-readtable))
(defun qd-scale-exponent (original-x)
(let* ((x original-x))
......
......@@ -24,8 +24,7 @@
(in-package #:oct)
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *readtable* *oct-readtable*))
(named-readtables:in-readtable oct-readtable))
;; For log-gamma we use the asymptotic formula
;;
......
......@@ -50,9 +50,8 @@
(warn "Numeric argument ignored in #~DQ" arg))
(read-qd-real-or-complex stream))
(defvar *oct-readtable*
(let ((rt (copy-readtable nil)))
(set-dispatch-macro-character #\# #\Q #'qd-class-reader rt)
rt)
"Readtable that extends the standard readtable to include #q for
reading QD-REAL and QD-COMPLEX numbers")
;; Readtable that extends the standard readtable to include #q for
;; reading QD-REAL and QD-COMPLEX numbers
(named-readtables:defreadtable oct:oct-readtable
(:merge :standard)
(:dispatch-macro-char #\# #\Q #'qd-class-reader))
......@@ -24,8 +24,7 @@
(in-package #:oct)
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *readtable* *oct-readtable*))
(named-readtables:in-readtable oct-readtable))
;; Theta functions
;;
......
......@@ -25,8 +25,7 @@
(in-package #:oct)
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *readtable* *oct-readtable*))
(named-readtables:in-readtable oct:oct-readtable))
;; For the tests, we need to turn off underflow for clisp.
#+clisp
......@@ -91,15 +90,6 @@
bessel-j-1/2-complex.d.1
bessel-j-1/2-complex.q.1))
;; For cmucl, initialize *random-state* to a fixed starting point for
;; testing. If you want to change the starting state, just supply an
;; arg to init-random-state.
;;
;; TODO: Add support for other lisps.
#+cmucl
(setf *random-state* (kernel::make-random-object :state (kernel:init-random-state)))
;;; Some simple tests from the Yozo Hida's qd package.
(rt:deftest float.1
......
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