Completed the adaptation of (planet cce/scheme:7) to collects/unstable.
Removed the staging area collects/unstable/cce.
This commit is contained in:
parent
e7814b63a7
commit
5d212ce1bd
|
@ -1,3 +0,0 @@
|
||||||
#lang setup/infotab
|
|
||||||
|
|
||||||
(define name "Carl Eastlund's Scheme Utilities")
|
|
|
@ -1,10 +0,0 @@
|
||||||
#lang scheme
|
|
||||||
|
|
||||||
(require scheme/sandbox unstable/syntax unstable/sandbox)
|
|
||||||
|
|
||||||
(define (evaluator . require-specs)
|
|
||||||
(let* ([ev (make-scribble-evaluator 'scheme)])
|
|
||||||
(ev `(require ,@require-specs))
|
|
||||||
ev))
|
|
||||||
|
|
||||||
(provide evaluator)
|
|
|
@ -1,11 +0,0 @@
|
||||||
#lang scribble/doc
|
|
||||||
@(require scribble/manual
|
|
||||||
unstable/scribble
|
|
||||||
"../../scribblings/utils.rkt"
|
|
||||||
(for-label scheme/base))
|
|
||||||
|
|
||||||
@title[#:style '(toc)]{@bold{Carl Eastlund's Scheme Utilities}}
|
|
||||||
|
|
||||||
@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
|
|
||||||
|
|
||||||
@table-of-contents[]
|
|
|
@ -1,79 +0,0 @@
|
||||||
#lang scheme
|
|
||||||
|
|
||||||
(require scheme/pretty
|
|
||||||
srfi/67
|
|
||||||
unstable/require)
|
|
||||||
|
|
||||||
(require/provide schemeunit schemeunit/text-ui)
|
|
||||||
|
|
||||||
(provide (all-defined-out))
|
|
||||||
|
|
||||||
(define-syntax test
|
|
||||||
(syntax-rules ()
|
|
||||||
[(_ term) (test-case (pretty-format 'term) term)]
|
|
||||||
[(_ term ...) (test-case (pretty-format '(begin term ...)) term ...)]))
|
|
||||||
|
|
||||||
(define-syntax-rule (test-ok body ...)
|
|
||||||
(test (check-ok body ...)))
|
|
||||||
|
|
||||||
(define-syntax-rule (test-bad body ...)
|
|
||||||
(test (check-bad body ...)))
|
|
||||||
|
|
||||||
(define-syntax-rule (with/c c e)
|
|
||||||
(let () (with-contract value ([value c]) (define value e)) value))
|
|
||||||
|
|
||||||
(define-syntax-rule (check-ok body ...)
|
|
||||||
(check-not-exn (lambda () body ...)))
|
|
||||||
|
|
||||||
(define-syntax-rule (check-bad body ...)
|
|
||||||
(check-exn exn:fail:contract? (lambda () body ...)))
|
|
||||||
|
|
||||||
(define-check (check-not compare actual expected)
|
|
||||||
(with-check-info*
|
|
||||||
(list (make-check-info 'comparison compare)
|
|
||||||
(make-check-actual actual)
|
|
||||||
(make-check-expected expected))
|
|
||||||
(lambda ()
|
|
||||||
(let* ([result (compare actual expected)])
|
|
||||||
(when result
|
|
||||||
(with-check-info*
|
|
||||||
(list (make-check-info 'result result))
|
|
||||||
(lambda () (fail-check))))))))
|
|
||||||
|
|
||||||
(define (check/sort actual expected
|
|
||||||
#:< [<< (<? default-compare)]
|
|
||||||
#:= [== equal?])
|
|
||||||
(with-check-info*
|
|
||||||
(list (make-check-name 'check/sort)
|
|
||||||
(make-check-info '< <<)
|
|
||||||
(make-check-info '= ==)
|
|
||||||
(make-check-info 'actual actual)
|
|
||||||
(make-check-info 'expected expected))
|
|
||||||
(lambda ()
|
|
||||||
(let* ([actual-sorted (sort actual <<)]
|
|
||||||
[actual-length (length actual-sorted)]
|
|
||||||
[expected-sorted (sort expected <<)]
|
|
||||||
[expected-length (length expected-sorted)])
|
|
||||||
(with-check-info*
|
|
||||||
(list (make-check-info 'actual-sorted actual-sorted)
|
|
||||||
(make-check-info 'expected-sorted expected-sorted))
|
|
||||||
(lambda ()
|
|
||||||
(unless (= actual-length expected-length)
|
|
||||||
(with-check-info*
|
|
||||||
(list (make-check-message
|
|
||||||
(format "expected ~a elements, but got ~a"
|
|
||||||
expected-length actual-length)))
|
|
||||||
(lambda () (fail-check))))
|
|
||||||
(let*-values
|
|
||||||
([(actuals expecteds)
|
|
||||||
(for/lists
|
|
||||||
[actuals expecteds]
|
|
||||||
([actual (in-list actual-sorted)]
|
|
||||||
[expected (in-list actual-sorted)]
|
|
||||||
#:when (not (== actual expected)))
|
|
||||||
(values actual expected))])
|
|
||||||
(unless (and (null? actuals) (null? expecteds))
|
|
||||||
(with-check-info*
|
|
||||||
(list (make-check-info 'actual-failed actuals)
|
|
||||||
(make-check-info 'expected-failed expecteds))
|
|
||||||
(lambda () (fail-check)))))))))))
|
|
|
@ -1,6 +0,0 @@
|
||||||
#lang scheme
|
|
||||||
|
|
||||||
(require "checks.ss")
|
|
||||||
|
|
||||||
(run-tests
|
|
||||||
(test-suite "scheme.plt"))
|
|
|
@ -114,9 +114,6 @@ Keep documentation and tests up to date.
|
||||||
@include-section["debug.scrbl"]
|
@include-section["debug.scrbl"]
|
||||||
@include-section["byte-counting-port.scrbl"]
|
@include-section["byte-counting-port.scrbl"]
|
||||||
|
|
||||||
;; This addition is temporary while integrating (planet cce/scheme:7):
|
|
||||||
@include-section["../cce/reference/manual.scrbl"]
|
|
||||||
|
|
||||||
@;{--------}
|
@;{--------}
|
||||||
|
|
||||||
@;{
|
@;{
|
||||||
|
|
Loading…
Reference in New Issue
Block a user