mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
improving docs
This commit is contained in:
Alex Shinn
parent
cb3734c2d1
commit
8d85bfc5d2
8 changed files with 303 additions and 156 deletions
10
Makefile
10
Makefile
|
|
@ -46,10 +46,12 @@ COMPILED_LIBS = $(CHIBI_COMPILED_LIBS) $(CHIBI_IO_COMPILED_LIBS) \
|
|||
BASE_INCLUDES = include/chibi/sexp.h include/chibi/features.h include/chibi/install.h include/chibi/bignum.h
|
||||
INCLUDES = $(BASE_INCLUDES) include/chibi/eval.h include/chibi/gc_heap.h
|
||||
|
||||
MODULE_DOCS := app ast config diff disasm equiv filesystem generic heap-stats io \
|
||||
loop match mime modules net net/http-server parse pathname process repl scribble stty \
|
||||
system test time trace type-inference uri weak monad/environment \
|
||||
crypto/sha2
|
||||
MODULE_DOCS := app ast base64 bytevector config crypto/md5 crypto/rsa \
|
||||
crypto/sha2 diff disasm doc equiv filesystem generic heap-stats io \
|
||||
iset/base iset/constructors iset/iterators loop match math/prime \
|
||||
memoize mime modules net net/http-server net/servlet parse pathname \
|
||||
process repl scribble string stty sxml system temp-file test time \
|
||||
trace type-inference uri weak monad/environment crypto/sha2
|
||||
|
||||
IMAGE_FILES = lib/chibi.img lib/red.img lib/snow.img
|
||||
|
||||
|
|
|
|||
101
doc/chibi.scrbl
101
doc/chibi.scrbl
|
|
@ -112,6 +112,7 @@ are listed below.
|
|||
\item{\ccode{SEXP_USE_RATIOS} - use exact ratios (enabled by default)}
|
||||
\item{\ccode{SEXP_USE_COMPLEX} - use complex numbers (enabled by default)}
|
||||
\item{\ccode{SEXP_USE_UTF8_STRINGS} - Unicode support (enabled by default)}
|
||||
\item{\ccode{SEXP_USE_STRING_INDEX_TABLE} - precompute offsets for O(1) \scheme{string-ref}}
|
||||
\item{\ccode{SEXP_USE_NO_FEATURES} - disable almost all features}
|
||||
]
|
||||
|
||||
|
|
@ -137,9 +138,10 @@ superset of
|
|||
\hyperlink["http://www.schemers.org/Documents/Standards/R5RS/HTML/"]{R5RS}.
|
||||
|
||||
The reader defaults to case-sensitive, like R6RS and R7RS but unlike
|
||||
R5RS. The default configuration includes the full numeric tower:
|
||||
fixnums, flonums, bignums, exact rationals and complex numbers, though
|
||||
this can be customized at compile time.
|
||||
R5RS. You can specify the -f option on the command-line to enable
|
||||
case-folding. The default configuration includes the full numeric
|
||||
tower: fixnums, flonums, bignums, exact rationals and complex numbers,
|
||||
though this can be customized at compile time.
|
||||
|
||||
Full continuations are supported, but currently continuations don't
|
||||
take C code into account. This means that you can call from Scheme to
|
||||
|
|
@ -179,11 +181,12 @@ other languages.
|
|||
|
||||
\subsection{Module System}
|
||||
|
||||
Chibi uses the R7RS module system natively, which is a simple static
|
||||
module system in the style of the
|
||||
\hyperlink["http://s48.org/"]{Scheme48} module system. As with most
|
||||
features this is optional, and can be ignored or completely disabled
|
||||
at compile time.
|
||||
Chibi supports the R7RS module system natively, which is a simple
|
||||
static module system. The Chibi implementation is actually a
|
||||
hierarchy of languages in the style of the
|
||||
\hyperlink["http://s48.org/"]{Scheme48} module system, allowing easy
|
||||
extension of the module system itself. As with most features this is
|
||||
optional, and can be ignored or completely disabled at compile time.
|
||||
|
||||
Modules names are hierarchical lists of symbols or numbers. A module
|
||||
definition uses the following form:
|
||||
|
|
@ -202,6 +205,7 @@ where \var{<library-declarations>} can be any of
|
|||
(include <file> ...) ;; load one or more files
|
||||
(include-ci <file> ...) ;; as include, with case-folding
|
||||
(include-shared <file> ...) ;; dynamic load a library (non-R7RS)
|
||||
(alias-for <library>) ;; a library alias (non-R7RS)
|
||||
}
|
||||
|
||||
\var{<import-spec>} can either be a module name or any of
|
||||
|
|
@ -286,23 +290,31 @@ constructors:
|
|||
|
||||
\subsection{Unicode}
|
||||
|
||||
Chibi supports Unicode strings, encoding them as utf8. This provides easy
|
||||
interoperability with many C libraries, but means that \scheme{string-ref} and
|
||||
\scheme{string-set!} are O(n), so they should be avoided in
|
||||
performance-sensitive code.
|
||||
Chibi supports Unicode strings and I/O natively. Case mappings and
|
||||
comparisons, character properties, formatting and regular expressions
|
||||
are all Unicode aware, supporting the latest version 13.0 of the
|
||||
Unicode standard.
|
||||
|
||||
Internally strings are encoded as UTF-8. This provides easy
|
||||
interoperability with many C libraries, but means that
|
||||
\scheme{string-ref} and \scheme{string-set!} are O(n), so they should
|
||||
be avoided in performance-sensitive code (unless you compile Chibi
|
||||
with SEXP_USE_STRING_INDEX_TABLE).
|
||||
|
||||
In general you should use high-level APIs such as \scheme{string-map}
|
||||
to ensure fast string iteration. String ports also provide a simple
|
||||
way to efficiently iterate and construct strings, by looping over an
|
||||
input string or accumulating characters in an output string.
|
||||
and portable way to efficiently iterate and construct strings, by
|
||||
looping over an input string or accumulating characters in an output
|
||||
string.
|
||||
|
||||
The \scheme{in-string} and \scheme{in-string-reverse} iterators in the
|
||||
\scheme{(chibi loop)} module will also iterate over strings
|
||||
efficiently while hiding the low-level details.
|
||||
|
||||
In the event that you do need a low-level interface, such as when
|
||||
writing your own iterator protocol, you should use the following
|
||||
string cursor API instead of indexes.
|
||||
writing your own iterator protocol, you should use string cursors.
|
||||
\scheme{(srfi 130)} provides a portable API for this, or you can use
|
||||
\scheme{(chibi string)} which builds on the following core procedures:
|
||||
|
||||
\itemlist[
|
||||
\item{\scheme{(string-cursor-start str)}
|
||||
|
|
@ -338,9 +350,10 @@ To use Chibi-Scheme in a program you need to link against the
|
|||
|
||||
\ccode{#include <chibi/eval.h>}
|
||||
|
||||
All definitions begin with a "sexp_" prefix, or "SEXP_" for constants.
|
||||
In addition to the prototypes and utility macros, this includes the
|
||||
following type definitions:
|
||||
All definitions begin with a "sexp_" prefix, or "SEXP_" for constants
|
||||
(deliberately chosen not to conflict with other Scheme implementations
|
||||
which typically use "scm_"). In addition to the prototypes and
|
||||
utility macros, this includes the following type definitions:
|
||||
|
||||
\itemlist[
|
||||
\item{\ctype{sexp} - an s-expression, used to represent all Scheme objects}
|
||||
|
|
@ -673,6 +686,7 @@ need to check manually before applying the predicate.
|
|||
\item{\ccode{sexp_numberp(obj)} - \var{obj} is any kind of number}
|
||||
\item{\ccode{sexp_charp(obj)} - \var{obj} is a character}
|
||||
\item{\ccode{sexp_stringp(obj)} - \var{obj} is a string}
|
||||
\item{\ccode{sexp_string_cursorp(obj)} - \var{obj} is a string cursor}
|
||||
\item{\ccode{sexp_bytesp(obj)} - \var{obj} is a bytevector}
|
||||
\item{\ccode{sexp_symbolp(obj)} - \var{obj} is a symbol}
|
||||
\item{\ccode{sexp_idp(obj)} - \var{obj} is a symbol or hygienic identifier}
|
||||
|
|
@ -730,7 +744,7 @@ check. The runtime does not prevent embedded NULLs inside strings,
|
|||
however data after the NULL may be ignored.
|
||||
|
||||
By default (unless you compile with -DSEXP_USE_UTF8_STRING=0), strings
|
||||
are interpreted as utf8 encoded on the Scheme side, as describe in
|
||||
are interpreted as UTF-8 encoded on the Scheme side, as describe in
|
||||
section Unicode above. In many cases you can ignore this on the C
|
||||
side and just treat the string as an opaque sequence of bytes.
|
||||
However, if you need to you can use the following macros to safely
|
||||
|
|
@ -748,7 +762,7 @@ compiled with:
|
|||
\item{\ccode{sexp sexp_substring_cursor(sexp ctx, sexp s, sexp i, sexp j)} - returns the substring between raw offsets \var{i} and \var{j}}
|
||||
]
|
||||
|
||||
When UTF8 support is not compiled in the cursor and non-cursor
|
||||
When UTF-8 support is not compiled in the cursor and non-cursor
|
||||
variants are equivalent.
|
||||
|
||||
\subsubsection{Accessors}
|
||||
|
|
@ -766,6 +780,8 @@ once.
|
|||
\item{\ccode{sexp_unbox_fixnum(obj)} - converts a fixnum to a C integer}
|
||||
\item{\ccode{sexp_make_character(ch)} - creates a new character representing char \var{ch}}
|
||||
\item{\ccode{sexp_unbox_character(obj)} - converts a character to a C char}
|
||||
\item{\ccode{sexp sexp_make_string_cursor(int offset)} - creates a string cursor for the given byte offset}
|
||||
\item{\ccode{int sexp_unbox_string_cursor(sexp sc)} - returns the offset for the given string cursor}
|
||||
\item{\ccode{sexp_car(pair)} - the car of \var{pair}}
|
||||
\item{\ccode{sexp_cdr(pair)} - the cdr of \var{pair}}
|
||||
\item{\ccode{sexp_ratio_numerator(q)} - the numerator of the ratio \var{q}}
|
||||
|
|
@ -1245,13 +1261,18 @@ snow-fort):
|
|||
\item{\hyperlink["http://srfi.schemers.org/srfi-135/srfi-135.html"]{(srfi 135) - immutable texts}}
|
||||
\item{\hyperlink["http://srfi.schemers.org/srfi-139/srfi-139.html"]{(srfi 139) - syntax parameters}}
|
||||
\item{\hyperlink["http://srfi.schemers.org/srfi-141/srfi-141.html"]{(srfi 141) - integer division}}
|
||||
\item{\hyperlink["http://srfi.schemers.org/srfi-143/srfi-142.html"]{(srfi 142) - bitwise operations}}
|
||||
\item{\hyperlink["http://srfi.schemers.org/srfi-143/srfi-143.html"]{(srfi 143) - fixnums}}
|
||||
\item{\hyperlink["http://srfi.schemers.org/srfi-144/srfi-144.html"]{(srfi 144) - flonums}}
|
||||
\item{\hyperlink["http://srfi.schemers.org/srfi-145/srfi-145.html"]{(srfi 145) - assumptions}}
|
||||
\item{\hyperlink["http://srfi.schemers.org/srfi-147/srfi-147.html"]{(srfi 147) - custom macro transformers}}
|
||||
\item{\hyperlink["http://srfi.schemers.org/srfi-151/srfi-151.html"]{(srfi 151) - bitwise operators}}
|
||||
\item{\hyperlink["http://srfi.schemers.org/srfi-154/srfi-154.html"]{(srfi 154) - first-class dynamic extents}}
|
||||
\item{\hyperlink["http://srfi.schemers.org/srfi-159/srfi-159.html"]{(srfi 159) - combinator formatting}}
|
||||
\item{\hyperlink["http://srfi.schemers.org/srfi-158/srfi-158.html"]{(srfi 158) - generators and accumulators}}
|
||||
\item{\hyperlink["http://srfi.schemers.org/srfi-160/srfi-160.html"]{(srfi 160) - homogeneous numeric vector libraries}}
|
||||
\item{\hyperlink["http://srfi.schemers.org/srfi-165/srfi-165.html"]{(srfi 165) - the environment Monad}}
|
||||
\item{\hyperlink["http://srfi.schemers.org/srfi-166/srfi-166.html"]{(srfi 166) - monadic formatting}}
|
||||
\item{\hyperlink["http://srfi.schemers.org/srfi-166/srfi-188.html"]{(srfi 188) - splicing binding constructs for syntactic keywords}}
|
||||
|
||||
]
|
||||
|
||||
|
|
@ -1264,12 +1285,24 @@ namespace.
|
|||
|
||||
\item{\hyperlink["lib/chibi/ast.html"]{(chibi ast) - Abstract Syntax Tree and other internal data types}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/base64.html"]{(chibi base64) - Base64 encoding and decoding}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/bytevector.html"]{(chibi bytevector) - Bytevector Utilities}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/config.html"]{(chibi config) - General configuration management}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/disasm.html"]{(chibi diff) - LCS Algorithm and diff utilities}}
|
||||
\item{\hyperlink["lib/chibi/crypto/md5.html"]{(chibi crypto md5) - MD5 hash}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/crypto/rsa.html"]{(chibi crypto rsa) - RSA public key encryption}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/crypto/sha2.html"]{(chibi crypto sha2) - SHA-2 hash}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/diff.html"]{(chibi diff) - LCS Algorithm and diff utilities}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/disasm.html"]{(chibi disasm) - Disassembler for the virtual machine}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/doc.html"]{(chibi doc) - Chibi documentation utilities}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/equiv.html"]{(chibi equiv) - A version of \scheme{equal?} which is guaranteed to terminate}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/filesystem.html"]{(chibi filesystem) - Interface to the filesystem and file descriptor objects}}
|
||||
|
|
@ -1280,10 +1313,22 @@ namespace.
|
|||
|
||||
\item{\hyperlink["lib/chibi/io.html"]{(chibi io) - Various I/O extensions and custom ports}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/iset/base.html"]{(chibi iset base) - Compact integer sets}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/iset/base.html"]{(chibi iset base) - Compact integer sets}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/iset/constructors.html"]{(chibi iset constructors) - Compact integer set construction}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/iset/iterators.html"]{(chibi iset iterators) - Iterating over compact integer sets}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/loop.html"]{(chibi loop) - Fast and extensible loop syntax}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/match.html"]{(chibi match) - Intuitive and widely supported pattern matching syntax}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/math/prime.html"]{(chibi math prime) - Prime number utilities}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/memoize.html"]{(chibi memoize) - Procedure memoization}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/mime.html"]{(chibi mime) - Parse MIME files into SXML}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/modules.html"]{(chibi modules) - Introspection for the module system itself}}
|
||||
|
|
@ -1292,6 +1337,8 @@ namespace.
|
|||
|
||||
\item{\hyperlink["lib/chibi/net/http-server.html"]{(chibi net http-server) - Simple http-server with servlet support}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/net/servlet.html"]{(chibi net servlet) - HTTP servlets for http-server or CGI}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/parse.html"]{(chibi parse) - Parser combinators with convenient syntax}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/pathname.html"]{(chibi pathname) - Utilities to decompose and manipulate pathnames}}
|
||||
|
|
@ -1302,12 +1349,16 @@ namespace.
|
|||
|
||||
\item{\hyperlink["lib/chibi/scribble.html"]{(chibi scribble) - A parser for the scribble syntax used to write this manual}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/show.html"]{(chibi show) - A combinator formatting library}}
|
||||
\item{\hyperlink["lib/chibi/string.html"]{(chibi string) - Cursor-based string library (predecessor to SRFI 130)}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/stty.html"]{(chibi stty) - A high-level interface to ioctl}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/sxml.html"]{(chibi sxml) - SXML utilities}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/system.html"]{(chibi system) - Access to the host system and current user information}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/temp-file.html"]{(chibi temp-file) - Temporary file and directory creation}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/test.html"]{(chibi test) - A simple unit testing framework}}
|
||||
|
||||
\item{\hyperlink["lib/chibi/time.html"]{(chibi time) - An interface to the current system time}}
|
||||
|
|
@ -1325,7 +1376,7 @@ namespace.
|
|||
\section{Snow Package Manager}
|
||||
|
||||
Beyond the distributed modules, Chibi comes with a package manager
|
||||
based on \hyperlink["http://trac.sacrideo.us/wg/wiki/Snow"]{Snow2}
|
||||
based on \hyperlink["https://small.r7rs.org/wiki/Snow/"]{Snow2}
|
||||
which can be used to share R7RS libraries. Packages are distributed
|
||||
as tar gzipped files called "snowballs," and may contain multiple
|
||||
libraries. The program is installed as \scheme{snow-chibi}. The
|
||||
|
|
|
|||
|
|
@ -377,11 +377,15 @@
|
|||
(err-str (get-output-string tmp-err)))
|
||||
`(,@(if (string-null? out-str)
|
||||
'()
|
||||
`((div (@ (class . "output")) ,(ansi->sxml out-str))))
|
||||
`((div (@ (class . "output")) (pre ,(ansi->sxml out-str)))))
|
||||
,@(if (string-null? err-str)
|
||||
'()
|
||||
`((div (@ (class . "error")) ,(ansi->sxml err-str))))
|
||||
(div (@ (class . "result")) (code ,res-str))))))))
|
||||
`((div (@ (class . "error")) (pre ,(ansi->sxml err-str)))))
|
||||
,@(if (and (or (not (string-null? err-str))
|
||||
(not (string-null? out-str)))
|
||||
(eq? res (if #f #f)))
|
||||
'()
|
||||
`((div (@ (class . "result")) (code ,res-str))))))))))
|
||||
|
||||
(define (expand-example-import x env)
|
||||
(eval `(import ,@(cdr x))
|
||||
|
|
@ -486,7 +490,7 @@ div#notes {position: relative; top: 2em; left: 570px; max-width: 200px; height:
|
|||
div#footer {padding-bottom: 50px}
|
||||
.result { color: #000; background-color: #FFEADF; width: 100%; padding: 3px}
|
||||
.output { color: #000; background-color: beige; width: 100%; padding: 3px}
|
||||
.error { color: #000; background-color: #330000; width: 100%; padding: 3px}
|
||||
.error { color: #000; background-color: #F0B0B0; width: 100%; padding: 3px}
|
||||
.command { color: #000; background-color: #FFEADF; width: 100%; padding: 5px}
|
||||
"
|
||||
,(highlight-style))
|
||||
|
|
|
|||
|
|
@ -42,21 +42,28 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; test interface
|
||||
|
||||
;;> \section{Testing}
|
||||
|
||||
;;> \macro{(test [name] expect expr)}
|
||||
|
||||
;;> The primary interface to testing. Evaluate \var{expr} and check
|
||||
;;> that it is \scheme{equal?} to \var{expect}. \var{name} is used
|
||||
;;> in reporting, and defaults to a printed summary of \var{expr}.
|
||||
;;> Returns the status of the test (one of the symbols \scheme{'PASS},
|
||||
;;> \scheme{'FAIL}, \scheme{'SKIP}, \scheme{'ERROR}).
|
||||
;;> that it is equal to \var{expect}, and report the result, using
|
||||
;;> \var{name} or a printed summary of \var{expr}.
|
||||
;;>
|
||||
;;> If used inside a group this will contribute to the overall group
|
||||
;;> reporting, but can be used standalone.
|
||||
;;> reporting, but can be used standalone:
|
||||
;;>
|
||||
;;> \example{(test 4 (+ 2 2))}
|
||||
;;> \example{(test "add two and two" 4 (+ 2 2))}
|
||||
;;> \example{(test 3 (+ 2 2))}
|
||||
;;> \example{(test 4 (+ 2 "2"))}
|
||||
;;>
|
||||
;;> The equality comparison is made with
|
||||
;;> \scheme{current-test-comparator}, defaulting to
|
||||
;;> \scheme{test-equal?}, which is the same as \scheme{equal?} but
|
||||
;;> more permissive on floating point comparisons). Returns the
|
||||
;;> status of the test (one of the symbols \scheme{'PASS},
|
||||
;;> \scheme{'FAIL}, \scheme{'SKIP}, \scheme{'ERROR}).
|
||||
|
||||
(define-syntax test
|
||||
(syntax-rules (quote)
|
||||
|
|
@ -138,10 +145,12 @@
|
|||
(test-syntax-error 'test-error "1 or 2 arguments required"
|
||||
(test a ...)))))
|
||||
|
||||
;; TODO: Extract interesting variables so we can show their values on
|
||||
;; failure.
|
||||
;;> Low-level macro to pass alist info to the underlying \var{test-run}.
|
||||
|
||||
(define-syntax test-propagate-info
|
||||
(syntax-rules ()
|
||||
;; TODO: Extract interesting variables so we can show their values
|
||||
;; on failure. Vars are empty for now.
|
||||
((test-propagate-info name expect expr info)
|
||||
(test-vars () name expect expr info))))
|
||||
|
||||
|
|
@ -156,25 +165,64 @@
|
|||
(var-values . ,(list vars ...))
|
||||
(key . val) ...)))))
|
||||
|
||||
;;> Exits with a failure status if any tests have failed,
|
||||
;;> and a successful status otherwise.
|
||||
;;> The procedural interface to testing. \var{expect} and \var{expr}
|
||||
;;> should be thunks, and \var{info} is an alist of properties used in
|
||||
;;> test reporting.
|
||||
|
||||
(define (test-exit)
|
||||
(exit (zero? (test-failure-count))))
|
||||
(define (test-run expect expr info)
|
||||
(let ((info (test-expand-info info)))
|
||||
(if (and (cond ((current-test-group)
|
||||
=> (lambda (g) (not (test-group-ref g 'skip-group?))))
|
||||
(else #t))
|
||||
(or (and (not (any (lambda (f) (f info)) (current-test-removers)))
|
||||
(or (pair? (current-test-removers))
|
||||
(null? (current-test-filters))))
|
||||
(any (lambda (f) (f info)) (current-test-filters))))
|
||||
((current-test-applier) expect expr info)
|
||||
((current-test-skipper) info))))
|
||||
|
||||
;;> Returns true if either \scheme{(equal? expect res)}, or
|
||||
;;> \var{expect} is inexact and \var{res} is within
|
||||
;;> \scheme{current-test-epsilon} of \var{expect}.
|
||||
|
||||
(define (test-equal? expect res)
|
||||
(or (equal? expect res)
|
||||
(if (real? expect)
|
||||
(and (inexact? expect)
|
||||
(real? res)
|
||||
;; tests which expect an inexact value can
|
||||
;; accept an equivalent exact value
|
||||
;; (inexact? res)
|
||||
(approx-equal? expect res (current-test-epsilon)))
|
||||
(and (complex? res)
|
||||
(complex? expect)
|
||||
(test-equal? (real-part expect) (real-part res))
|
||||
(test-equal? (imag-part expect) (imag-part res))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; group interface
|
||||
|
||||
;;> \section{Test Groups}
|
||||
|
||||
;;> Tests can be collected in groups for
|
||||
|
||||
;;> Wraps \var{body} as a single test group, which can be filtered
|
||||
;;> and summarized separately.
|
||||
|
||||
;;> \example{
|
||||
;;> (test-group "pi"
|
||||
;;> (test 3.14159 (acos -1))
|
||||
;;> (test 3 (acos -1))
|
||||
;;> (test 3.14159 (acos "-1")))
|
||||
;;> }
|
||||
|
||||
(define-syntax test-group
|
||||
(syntax-rules ()
|
||||
((_ name-expr body ...)
|
||||
(let ((name name-expr)
|
||||
(old-group (current-test-group)))
|
||||
(if (not (string? name))
|
||||
(error "a name is required, got " 'name-expr name))
|
||||
(when (not (string? name))
|
||||
(error "a name is required, got " 'name-expr name))
|
||||
(test-begin name)
|
||||
(guard
|
||||
(exn
|
||||
|
|
@ -188,6 +236,78 @@
|
|||
(test-end name)
|
||||
(current-test-group old-group)))))
|
||||
|
||||
;;> Begin testing a new group until the closing \scheme{(test-end)}.
|
||||
|
||||
(define (test-begin . o)
|
||||
(let* ((name (if (pair? o) (car o) ""))
|
||||
(parent (current-test-group))
|
||||
(group (make-test-group name parent)))
|
||||
;; include a newline if we are directly nested in a parent with no
|
||||
;; tests yet
|
||||
(when (and parent
|
||||
(zero? (test-group-ref parent 'subgroups-count 0))
|
||||
(not (test-group-ref parent 'verbose)))
|
||||
(newline))
|
||||
;; header
|
||||
(cond
|
||||
((test-group-ref group 'skip-group?)
|
||||
(display (make-string (or (test-group-indent-width group) 0) #\space))
|
||||
(display (strikethrough (bold (string-append name ":"))))
|
||||
(display " SKIP"))
|
||||
((test-group-ref group 'verbose)
|
||||
(display
|
||||
(test-header-line
|
||||
(string-append "testing " name)
|
||||
(or (test-group-indent-width group) 0))))
|
||||
(else
|
||||
(display
|
||||
(string-append
|
||||
(make-string (or (test-group-indent-width group) 0)
|
||||
#\space)
|
||||
(bold (string-append name ": "))))))
|
||||
;; set the current test group
|
||||
(current-test-group group)))
|
||||
|
||||
;;> Ends testing group introduced with \scheme{(test-begin)}, and
|
||||
;;> summarizes the results. The \var{name} is optional, but if
|
||||
;;> present should match the corresponding \scheme{test-begin} name,
|
||||
;;> or a warning is printed.
|
||||
|
||||
(define (test-end . o)
|
||||
(let ((name (and (pair? o) (car o))))
|
||||
(cond
|
||||
((current-test-group)
|
||||
=> (lambda (group)
|
||||
(when (and name (not (equal? name (test-group-name group))))
|
||||
(warning "mismatched test-end:" name (test-group-name group)))
|
||||
(let ((parent (test-group-ref group 'parent)))
|
||||
(when (and (test-group-ref group 'skip-group?)
|
||||
(zero? (test-group-ref group 'subgroups-count 0)))
|
||||
(newline))
|
||||
;; only report if there's something to say
|
||||
((current-test-group-reporter) group)
|
||||
(when parent
|
||||
(test-group-inc! parent 'subgroups-count)
|
||||
(cond
|
||||
((test-group-ref group 'skip-group?)
|
||||
(test-group-inc! parent 'subgroups-skip))
|
||||
((and (zero? (test-group-ref group 'FAIL 0))
|
||||
(zero? (test-group-ref group 'ERROR 0))
|
||||
(= (test-group-ref group 'subgroups-pass 0)
|
||||
(test-group-ref group 'subgroups-count 0)))
|
||||
(test-group-inc! parent 'subgroups-pass))))
|
||||
(current-test-group parent)
|
||||
group))))))
|
||||
|
||||
;;> Exits with a failure status if any tests have failed,
|
||||
;;> and a successful status otherwise.
|
||||
|
||||
(define (test-exit)
|
||||
(when (current-test-group)
|
||||
(warning "calling test-exit with unfinished test group:"
|
||||
(test-group-name (current-test-group))))
|
||||
(exit (zero? (test-failure-count))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; utilities
|
||||
|
||||
|
|
@ -198,6 +318,8 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; test-group representation
|
||||
|
||||
;;> \section{Accessors}
|
||||
|
||||
;; (name (prop value) ...)
|
||||
(define (make-test-group name . o)
|
||||
(let ((parent (and (pair? o) (car o)))
|
||||
|
|
@ -223,7 +345,7 @@
|
|||
|
||||
;;> Returns the name of a test group info object.
|
||||
|
||||
(define test-group-name car)
|
||||
(define (test-group-name group) (car group))
|
||||
|
||||
;;> Returns the value of a \var{field} in a test var{group} info
|
||||
;;> object. \var{field} should be a symbol, and predefined fields
|
||||
|
|
@ -394,18 +516,6 @@
|
|||
,@info)
|
||||
info)))
|
||||
|
||||
(define (test-run expect expr info)
|
||||
(let ((info (test-expand-info info)))
|
||||
(if (and (cond ((current-test-group)
|
||||
=> (lambda (g) (not (test-group-ref g 'skip-group?))))
|
||||
(else #t))
|
||||
(or (and (not (any (lambda (f) (f info)) (current-test-removers)))
|
||||
(or (pair? (current-test-removers))
|
||||
(null? (current-test-filters))))
|
||||
(any (lambda (f) (f info)) (current-test-filters))))
|
||||
((current-test-applier) expect expr info)
|
||||
((current-test-skipper) info))))
|
||||
|
||||
(define (test-default-applier expect expr info)
|
||||
(let* ((group (current-test-group))
|
||||
(indent (and group (test-group-indent-width group))))
|
||||
|
|
@ -425,7 +535,7 @@
|
|||
(guard
|
||||
(exn
|
||||
(else
|
||||
((current-test-handler)
|
||||
((current-test-reporter)
|
||||
(if (assq-ref info 'expect-error) 'PASS 'ERROR)
|
||||
(append `((exception . ,exn)) info))))
|
||||
(let ((res (expr)))
|
||||
|
|
@ -437,10 +547,10 @@
|
|||
'PASS
|
||||
'FAIL))
|
||||
(info `((result . ,res) (expected . ,expect-val) ,@info)))
|
||||
((current-test-handler) status info)))))))
|
||||
((current-test-reporter) status info)))))))
|
||||
|
||||
(define (test-default-skipper info)
|
||||
((current-test-handler) 'SKIP info))
|
||||
((current-test-reporter) 'SKIP info))
|
||||
|
||||
(define (test-status-color status)
|
||||
(case status
|
||||
|
|
@ -454,6 +564,8 @@
|
|||
|
||||
(define (test-status-code status)
|
||||
((test-status-color status)
|
||||
;; alternatively: ❗, ✗, ‒, ✓
|
||||
;; unfortunately, these have ambiguous width
|
||||
(case status
|
||||
((ERROR) "!")
|
||||
((FAIL) "x")
|
||||
|
|
@ -697,100 +809,62 @@
|
|||
(test-group-inc! parent 'total-fail fail)
|
||||
(test-group-inc! parent 'total-error err))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (test-equal? expect res)
|
||||
(or (equal? expect res)
|
||||
(if (real? expect)
|
||||
(and (inexact? expect)
|
||||
(real? res)
|
||||
;; tests which expect an inexact value can
|
||||
;; accept an equivalent exact value
|
||||
;; (inexact? res)
|
||||
(approx-equal? expect res (current-test-epsilon)))
|
||||
(and (complex? res)
|
||||
(complex? expect)
|
||||
(test-equal? (real-part expect) (real-part res))
|
||||
(test-equal? (imag-part expect) (imag-part res))))))
|
||||
|
||||
;;> Begin testing a new group until the closing \scheme{(test-end)}.
|
||||
|
||||
(define (test-begin . o)
|
||||
(let* ((name (if (pair? o) (car o) ""))
|
||||
(parent (current-test-group))
|
||||
(group (make-test-group name parent)))
|
||||
;; include a newline if we are directly nested in a parent with no
|
||||
;; tests yet
|
||||
(cond
|
||||
((and parent
|
||||
(zero? (test-group-ref parent 'subgroups-count 0))
|
||||
(not (test-group-ref parent 'verbose)))
|
||||
(newline)))
|
||||
;; header
|
||||
(cond
|
||||
((test-group-ref group 'skip-group?)
|
||||
(display (make-string (or (test-group-indent-width group) 0) #\space))
|
||||
(display (strikethrough (bold (string-append name ":"))))
|
||||
(display " SKIP"))
|
||||
((test-group-ref group 'verbose)
|
||||
(display
|
||||
(test-header-line
|
||||
(string-append "testing " name)
|
||||
(or (test-group-indent-width group) 0))))
|
||||
(else
|
||||
(display
|
||||
(string-append
|
||||
(make-string (or (test-group-indent-width group) 0)
|
||||
#\space)
|
||||
(bold (string-append name ": "))))))
|
||||
;; set the current test group
|
||||
(current-test-group group)))
|
||||
|
||||
;;> Ends testing group introduced with \scheme{(test-begin)}, and
|
||||
;;> summarizes the results.
|
||||
|
||||
(define (test-end . o)
|
||||
(cond
|
||||
((current-test-group)
|
||||
=> (lambda (group)
|
||||
(if (and (pair? o) (not (equal? (car o) (test-group-name group))))
|
||||
(warning "mismatched test-end:" (car o) (test-group-name group)))
|
||||
(let ((parent (test-group-ref group 'parent)))
|
||||
(if (and (test-group-ref group 'skip-group?)
|
||||
(zero? (test-group-ref group 'subgroups-count 0)))
|
||||
(newline))
|
||||
;; only report if there's something to say
|
||||
((current-test-group-reporter) group)
|
||||
(cond
|
||||
(parent
|
||||
(test-group-inc! parent 'subgroups-count)
|
||||
(cond
|
||||
((test-group-ref group 'skip-group?)
|
||||
(test-group-inc! parent 'subgroups-skip))
|
||||
((and (zero? (test-group-ref group 'FAIL 0))
|
||||
(zero? (test-group-ref group 'ERROR 0))
|
||||
(= (test-group-ref group 'subgroups-pass 0)
|
||||
(test-group-ref group 'subgroups-count 0)))
|
||||
(test-group-inc! parent 'subgroups-pass)))))
|
||||
(current-test-group parent)
|
||||
group)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; parameters
|
||||
|
||||
;;> \section{Parameters}
|
||||
|
||||
;;> The current test group as started by \scheme{test-group} or
|
||||
;;> \scheme{test-begin}.
|
||||
|
||||
(define current-test-group (make-parameter #f))
|
||||
|
||||
;;> If true, show more verbose output per test. Inferred from the
|
||||
;;> environment variable TEST_VERBOSE.
|
||||
|
||||
(define current-test-verbosity
|
||||
(make-parameter
|
||||
(cond ((get-environment-variable "TEST_VERBOSE")
|
||||
=> (lambda (s) (not (member s '("" "0")))))
|
||||
(else #f))))
|
||||
|
||||
;;> The epsilon used for floating point comparisons.
|
||||
|
||||
(define current-test-epsilon (make-parameter 1e-5))
|
||||
|
||||
;;> The underlying comparator used in testing, defaults to
|
||||
;;> \scheme{test-equal?}.
|
||||
|
||||
(define current-test-comparator (make-parameter test-equal?))
|
||||
|
||||
;;> The test applier - what we do with non-skipped tests. Takes the
|
||||
;;> same signature as \scheme{test-run}, should be responsible for
|
||||
;;> evaluating the thunks, determining the status of the test, and
|
||||
;;> passing this information to \scheme{current-test-reporter}.
|
||||
|
||||
(define current-test-applier (make-parameter test-default-applier))
|
||||
(define current-test-handler (make-parameter test-default-handler))
|
||||
|
||||
;;> The test skipper - what we do with non-skipped tests. This should
|
||||
;;> not evaluate the thunks and simply pass off to
|
||||
;;> \scheme{current-test-reporter}.
|
||||
|
||||
(define current-test-skipper (make-parameter test-default-skipper))
|
||||
|
||||
;;> Takes two arguments, the symbol status of the test and the info
|
||||
;;> alist. Reports the result of the test and updates bookkeeping in
|
||||
;;> the current test group for reporting.
|
||||
|
||||
(define current-test-reporter (make-parameter test-default-handler))
|
||||
|
||||
;;> Takes one argument, a test group, and prints a summary of the test
|
||||
;;> results for that group.
|
||||
|
||||
(define current-test-group-reporter
|
||||
(make-parameter test-default-group-reporter))
|
||||
|
||||
;;> A running count of all test failures and errors across all groups
|
||||
;;> (and threads). Used by \scheme{test-exit}.
|
||||
|
||||
(define test-failure-count (make-parameter 0))
|
||||
|
||||
(define test-first-indentation
|
||||
|
|
|
|||
|
|
@ -5,13 +5,13 @@
|
|||
test test-equal test-error test-assert test-not test-values
|
||||
test-group current-test-group
|
||||
test-begin test-end test-syntax-error test-propagate-info
|
||||
test-vars test-run test-exit
|
||||
test-run test-exit test-equal?
|
||||
;; test and group data
|
||||
test-get-name! test-group-name test-group-ref
|
||||
test-group-set! test-group-inc! test-group-push!
|
||||
;; parameters
|
||||
current-test-verbosity
|
||||
current-test-applier current-test-handler current-test-skipper
|
||||
current-test-applier current-test-skipper current-test-reporter
|
||||
current-test-group-reporter test-failure-count
|
||||
current-test-epsilon current-test-comparator
|
||||
current-test-filters current-test-removers
|
||||
|
|
|
|||
|
|
@ -34,11 +34,16 @@
|
|||
(show-trace-result cell args res)
|
||||
res))))
|
||||
|
||||
;;> Write a trace of all calls to the procedure \var{proc} to
|
||||
;;> \scheme{(current-error-port)}.
|
||||
|
||||
(define-syntax trace
|
||||
(syntax-rules ()
|
||||
((trace id)
|
||||
(trace-cell (env-cell (interaction-environment) 'id)))))
|
||||
|
||||
;;> Remove any active traces on the procedure \var{proc}.
|
||||
|
||||
(define-syntax untrace
|
||||
(syntax-rules ()
|
||||
((untrace id)
|
||||
|
|
@ -50,6 +55,8 @@
|
|||
(for-each (lambda (x) (display x out)) args)
|
||||
(newline out)))
|
||||
|
||||
;;> Trace a specific environment cell.
|
||||
|
||||
(define (trace-cell cell)
|
||||
(let ((tab (all-traces)))
|
||||
(cond
|
||||
|
|
@ -61,6 +68,8 @@
|
|||
(hash-table-set! tab cell (cdr cell))
|
||||
(set-cdr! cell (make-tracer cell))))))
|
||||
|
||||
;;> Untrace an environment cell.
|
||||
|
||||
(define (untrace-cell cell)
|
||||
(let ((tab (all-traces)))
|
||||
(cond
|
||||
|
|
@ -73,6 +82,8 @@
|
|||
(hash-table-delete! tab cell)
|
||||
(set-cdr! cell proc))))))
|
||||
|
||||
;;> Remove all active procedure traces.
|
||||
|
||||
(define (untrace-all)
|
||||
(hash-table-walk (all-traces) (lambda (cell proc) (set-cdr! cell proc)))
|
||||
(all-traces (make-hash-table eq?)))
|
||||
|
|
|
|||
|
|
@ -1,17 +1,4 @@
|
|||
|
||||
;;> \subsubsubsection{(trace proc)}
|
||||
|
||||
;;> Write a trace of all calls to the procedure \var{proc} to
|
||||
;;> \scheme{(current-error-port)}.
|
||||
|
||||
;;> \subsubsubsection{(untrace proc)}
|
||||
|
||||
;;> Remove any active traces on the procedure \var{proc}.
|
||||
|
||||
;;> \subsubsubsection{(untrace-all)}
|
||||
|
||||
;;> Remove all active procedure traces.
|
||||
|
||||
(define-library (chibi trace)
|
||||
(export trace untrace untrace-all trace-cell untrace-cell)
|
||||
(import (chibi) (chibi ast) (srfi 38) (srfi 39) (srfi 69))
|
||||
|
|
|
|||
|
|
@ -1,6 +1,24 @@
|
|||
|
||||
;;> Library for weak data structures.
|
||||
|
||||
;;> \procedure{(make-ephemeron key value)}
|
||||
|
||||
;;> Returns a new ephemeron. This ephemeron holds a weak reference to
|
||||
;;> \var{key}, such that \var{value} will only be traced by the GC if
|
||||
;;> \var{key} is referenced from an external object.
|
||||
|
||||
;;> \procedure{(ephemeron? x)}
|
||||
;;> Returns true iff \var{x} is an ephemeron.
|
||||
|
||||
;;> \procedure{(ephemeron-broken? ephemeron)}
|
||||
;;> Returns true iff \var{ephemeron}s \var{key} has been GCed.
|
||||
|
||||
;;> \procedure{(ephemeron-key ephemeron)}
|
||||
;;> Returns \var{ephemeron}s \var{key}, or \scheme{#f} if it has been GCed.
|
||||
|
||||
;;> \procedure{(ephemeron-value ephemeron)}
|
||||
;;> Returns \var{ephemeron}s \var{value}.
|
||||
|
||||
(define-library (chibi weak)
|
||||
(export make-ephemeron ephemeron? ephemeron-broken?
|
||||
ephemeron-key ephemeron-value
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue