Add more correct dependencies for racket-test
.
This commit is contained in:
parent
92143dcb3a
commit
04495bd420
|
@ -1,3 +1,14 @@
|
||||||
#lang setup/infotab
|
#lang setup/infotab
|
||||||
|
|
||||||
(define collection 'multi)
|
(define collection 'multi)
|
||||||
|
(define deps '("unstable-debug-lib"
|
||||||
|
"unstable-flonum-lib"
|
||||||
|
"compiler-lib"
|
||||||
|
"sandbox-lib"
|
||||||
|
"compatibility-lib"
|
||||||
|
"pconvert-lib"
|
||||||
|
;; for `pkg` tests
|
||||||
|
"web-server-lib"
|
||||||
|
"rackunit-lib"
|
||||||
|
;; for `json` tests
|
||||||
|
"at-exp-lib"))
|
||||||
|
|
|
@ -2,9 +2,15 @@
|
||||||
(Section 'fixnum)
|
(Section 'fixnum)
|
||||||
(require scheme/fixnum
|
(require scheme/fixnum
|
||||||
scheme/unsafe/ops
|
scheme/unsafe/ops
|
||||||
(prefix-in r6: rnrs/arithmetic/fixnums-6)
|
|
||||||
"for-util.rkt")
|
"for-util.rkt")
|
||||||
|
|
||||||
|
(define 64-bit? (fixnum? (expt 2 33)))
|
||||||
|
|
||||||
|
(define (fixnum-width) (if 64-bit? 63 31))
|
||||||
|
(define (least-fixnum) (if 64-bit? (- (expt 2 62)) -1073741824))
|
||||||
|
(define (greatest-fixnum) (if 64-bit? (- (expt 2 62) 1) +1073741823))
|
||||||
|
|
||||||
|
|
||||||
(define unary-table
|
(define unary-table
|
||||||
(list (list fxnot unsafe-fxnot)
|
(list (list fxnot unsafe-fxnot)
|
||||||
(list fxabs unsafe-fxabs)
|
(list fxabs unsafe-fxabs)
|
||||||
|
@ -89,7 +95,7 @@
|
||||||
(test #t same-results (list-ref line 0) (list-ref line 1) (list i j))))))
|
(test #t same-results (list-ref line 0) (list-ref line 1) (list i j))))))
|
||||||
|
|
||||||
(define (same-results/extremum)
|
(define (same-results/extremum)
|
||||||
(let ([interesting-values (list (r6:least-fixnum) -1 0 1 (r6:greatest-fixnum))])
|
(let ([interesting-values (list (least-fixnum) -1 0 1 (greatest-fixnum))])
|
||||||
(for ([line (in-list unary-table)])
|
(for ([line (in-list unary-table)])
|
||||||
(for ([i (in-list interesting-values)])
|
(for ([i (in-list interesting-values)])
|
||||||
(test #t same-results (list-ref line 0) (list-ref line 1) (list i))))
|
(test #t same-results (list-ref line 0) (list-ref line 1) (list i))))
|
||||||
|
@ -105,7 +111,7 @@
|
||||||
(for ([ignore (in-range 0 800)])
|
(for ([ignore (in-range 0 800)])
|
||||||
(let ([i (random-fixnum)]
|
(let ([i (random-fixnum)]
|
||||||
[j (random-fixnum)]
|
[j (random-fixnum)]
|
||||||
[k (inexact->exact (floor (* (random) (+ 1 (r6:fixnum-width)))))]
|
[k (inexact->exact (floor (* (random) (+ 1 (fixnum-width)))))]
|
||||||
[more-fixnums (build-list (random 20) (λ (i) (random-fixnum)))])
|
[more-fixnums (build-list (random 20) (λ (i) (random-fixnum)))])
|
||||||
(for ([line (in-list unary-table)])
|
(for ([line (in-list unary-table)])
|
||||||
(test #t same-results (list-ref line 0) (list-ref line 1) (list i)))
|
(test #t same-results (list-ref line 0) (list-ref line 1) (list i)))
|
||||||
|
@ -121,7 +127,7 @@
|
||||||
(test #t same-results (list-ref line 0) (list-ref line 1) more-fixnums)))))
|
(test #t same-results (list-ref line 0) (list-ref line 1) more-fixnums)))))
|
||||||
|
|
||||||
(define (random-fixnum)
|
(define (random-fixnum)
|
||||||
(inexact->exact (floor (+ (r6:least-fixnum) (* (random) (+ (- (r6:greatest-fixnum) (r6:least-fixnum)) 1))))))
|
(inexact->exact (floor (+ (least-fixnum) (* (random) (+ (- (greatest-fixnum) (least-fixnum)) 1))))))
|
||||||
|
|
||||||
;; check the arities
|
;; check the arities
|
||||||
(for-each (λ (x) (apply check-arity x)) table)
|
(for-each (λ (x) (apply check-arity x)) table)
|
||||||
|
|
|
@ -679,8 +679,8 @@
|
||||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Check printing of an error message:
|
;; Check printing of an error message:
|
||||||
|
|
||||||
(err/rt-test (eval '(module bad-module racket/base
|
(err/rt-test (eval '(module bad-module '#%kernel
|
||||||
(require (for-meta -1 (only-in racket cons) (only-in r5rs cons)))))
|
(#%require (for-meta -1 (only racket make-base-namespace) (only scheme make-base-namespace)))))
|
||||||
(lambda (exn) (regexp-match? #rx"phase -1" (exn-message exn))))
|
(lambda (exn) (regexp-match? #rx"phase -1" (exn-message exn))))
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -494,33 +494,33 @@
|
||||||
identifier-binding* #'#%pmb)
|
identifier-binding* #'#%pmb)
|
||||||
|
|
||||||
(let ([b (identifier-binding
|
(let ([b (identifier-binding
|
||||||
(syntax-case (expand #'(module m scheme/base
|
(syntax-case (expand #'(module m racket/base
|
||||||
(require (only-in (lib "lang/htdp-intermediate.rkt") [cons bcons]))
|
(require (only-in scheme/base [make-base-namespace s-mbn]))
|
||||||
bcons)) ()
|
s-mbn)) ()
|
||||||
[(mod m mz (#%mod-beg run-conf req (app call-with-values (lambda () cons) print)))
|
[(mod m mz (#%mod-beg run-conf req (app call-with-values (lambda () make-base-namespace) print)))
|
||||||
(let ([s (syntax cons)])
|
(let ([s (syntax make-base-namespace)])
|
||||||
(test 'bcons syntax-e s)
|
(test 's-mbn syntax-e s)
|
||||||
s)]))])
|
s)]))])
|
||||||
(let-values ([(real real-base) (module-path-index-split (car b))]
|
(let-values ([(real real-base) (module-path-index-split (car b))]
|
||||||
[(nominal nominal-base) (module-path-index-split (caddr b))])
|
[(nominal nominal-base) (module-path-index-split (caddr b))])
|
||||||
(test '"teachprims.rkt" values real)
|
(test '"private/namespace.rkt" values real)
|
||||||
(test 'beginner-cons cadr b)
|
(test 'make-base-namespace cadr b)
|
||||||
(test '(lib "lang/htdp-intermediate.rkt") values nominal)
|
(test 'scheme/base values nominal)
|
||||||
(test 'cons cadddr b)))
|
(test 'make-base-namespace cadddr b)))
|
||||||
|
|
||||||
(let ([b (identifier-binding
|
(let ([b (identifier-binding
|
||||||
(syntax-case (expand #'(module m (lib "lang/htdp-intermediate.rkt")
|
(syntax-case (expand #'(module m scheme/base
|
||||||
cons)) ()
|
make-base-namespace)) ()
|
||||||
[(mod m beg (#%mod-beg (app call-w-vals (lam () cons) prnt)))
|
[(mod m beg (#%mod-beg run-conf (app call-w-vals (lam () make-base-namespace) prnt)))
|
||||||
(let ([s (syntax cons)])
|
(let ([s (syntax make-base-namespace)])
|
||||||
(test 'cons syntax-e s)
|
(test 'make-base-namespace syntax-e s)
|
||||||
s)]))])
|
s)]))])
|
||||||
(let-values ([(real real-base) (module-path-index-split (car b))]
|
(let-values ([(real real-base) (module-path-index-split (car b))]
|
||||||
[(nominal nominal-base) (module-path-index-split (caddr b))])
|
[(nominal nominal-base) (module-path-index-split (caddr b))])
|
||||||
(test '"teachprims.rkt" values real)
|
(test '"private/namespace.rkt" values real)
|
||||||
(test 'beginner-cons cadr b)
|
(test 'make-base-namespace cadr b)
|
||||||
(test '(lib "lang/htdp-intermediate.rkt") values nominal)
|
(test 'scheme/base values nominal)
|
||||||
(test 'cons cadddr b)))
|
(test 'make-base-namespace cadddr b)))
|
||||||
|
|
||||||
(let ()
|
(let ()
|
||||||
(define (check wrap)
|
(define (check wrap)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user