fix some tests
This commit is contained in:
Matthew Flatt
parent
0db19423b4
commit
92872addf2
|
|
@ -19,17 +19,10 @@ Robby
|
|||
(require redex/examples/beginner)
|
||||
(collect-garbage)
|
||||
(printf "Now\n")
|
||||
;; Check for the command line flag --skip-struct-test
|
||||
;; If it's set, don't run the (currently-failing) test
|
||||
;; for define-struct in beginner
|
||||
;; This flag is so that DrDr can avoid raising an error here.
|
||||
;; -- samth
|
||||
(define run-struct-test?
|
||||
(let ([run? #t])
|
||||
(command-line
|
||||
#:once-each
|
||||
["--skip-struct-test" "skip failing struct test" (set! run? #f)])
|
||||
run?))
|
||||
|
||||
;; At one point, the struct test was failing,
|
||||
;; and this flag could turn it off:
|
||||
(define run-struct-test? #t)
|
||||
|
||||
(time (begin (run-tests run-struct-test?)
|
||||
(run-tests run-struct-test?)
|
||||
|
|
|
|||
|
|
@ -23,3 +23,6 @@
|
|||
(call-with-input-file* f (lambda (in) (copy-port in (current-output-port))))
|
||||
(raise-user-error 'cat "bad file ~a" f)))))
|
||||
(flush-output)
|
||||
|
||||
;; No test:
|
||||
(module test racket/base)
|
||||
|
|
|
|||
|
|
@ -3,6 +3,10 @@
|
|||
racket/place
|
||||
"test-util.rkt")
|
||||
|
||||
(module drdr racket/base
|
||||
;; Run individual files for DrDr
|
||||
(void))
|
||||
|
||||
(define parallel 1)
|
||||
(let ([argv (current-command-line-arguments)])
|
||||
(unless (= (vector-length argv) 0)
|
||||
|
|
|
|||
|
|
@ -26,6 +26,7 @@ static int run(Scheme_Env *e, int argc, char *argv[])
|
|||
declare_modules(e);
|
||||
#else
|
||||
scheme_set_collects_path(scheme_make_path(MZ_COLLECTION_PATH));
|
||||
scheme_set_config_path(scheme_make_path(MZ_CONFIG_PATH));
|
||||
scheme_init_collection_paths(e, scheme_null);
|
||||
#endif
|
||||
|
||||
|
|
|
|||
|
|
@ -12,7 +12,9 @@
|
|||
(unless (equal? expected val)
|
||||
(error 'test "failed at ~s: ~e; expected: ~e" 'expr val expected))))
|
||||
|
||||
(define dir (collection-path "tests" "racket"))
|
||||
(define dir (let-values ([(base name dir?)
|
||||
(split-path (collection-file-path "embed-in-c.c" "tests" "racket"))])
|
||||
base))
|
||||
(define lib-dir (find-lib-dir))
|
||||
|
||||
(define (buildinfo def)
|
||||
|
|
@ -38,16 +40,23 @@
|
|||
"racket/place"
|
||||
"++lib"
|
||||
"tests/racket/embed-place"))
|
||||
(unless (system (format "cc -c -o embed-in-c.o ~a-DMZ_COLLECTION_PATH='\"~a\"' -I\"~a\" -DMZ_PRECISE_GC ~a embed-in-c.c"
|
||||
(unless (system (format (string-append "cc -c -o embed-in-c.o ~a"
|
||||
"-DMZ_COLLECTION_PATH='\"~a\"'"
|
||||
" -DMZ_CONFIG_PATH='\"~a\"'"
|
||||
" -I\"~a\" -DMZ_PRECISE_GC ~a embed-in-c.c")
|
||||
(if use-declare?
|
||||
(format "-DUSE_DECLARED_MODULE -I\"~a\" " (find-system-path 'temp-dir))
|
||||
"")
|
||||
(find-collects-dir)
|
||||
(find-config-dir)
|
||||
(find-include-dir)
|
||||
(buildinfo "CFLAGS")))
|
||||
(error "compile failed"))
|
||||
|
||||
(unless (system (format "cc -o embed-in-c embed-in-c.o -lm -ldl -pthread ~a"
|
||||
(unless (system (format "cc -o embed-in-c embed-in-c.o -lm -ldl ~a ~a"
|
||||
(case (system-type)
|
||||
[(macosx) ""]
|
||||
[else "-pthread"])
|
||||
(case (system-type 'link)
|
||||
[(framework)
|
||||
(format "-F\"~a\" -framework Racket" lib-dir)]
|
||||
|
|
|
|||
10
pkgs/racket-pkgs/racket-test/tests/racket/embed-place.rkt
Normal file
10
pkgs/racket-pkgs/racket-test/tests/racket/embed-place.rkt
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
#lang racket/base
|
||||
|
||||
;; This module is used by "embed-in-c.rkt"
|
||||
|
||||
(require racket/place)
|
||||
|
||||
(provide go)
|
||||
|
||||
(define (go ch)
|
||||
(place-channel-put ch 42))
|
||||
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket
|
||||
(require setup/link
|
||||
setup/dirs
|
||||
compiler/find-exe
|
||||
racket/sandbox)
|
||||
|
||||
|
|
@ -19,7 +20,9 @@
|
|||
(delete-directory/files work-dir))
|
||||
(make-directory work-dir)
|
||||
|
||||
(define link-file (build-path work-dir "links"))
|
||||
(make-directory (build-path work-dir (get-installation-name)))
|
||||
|
||||
(define link-file (build-path work-dir (get-installation-name) "links.rktd"))
|
||||
|
||||
;; ----------------------------------------
|
||||
;; running Racket
|
||||
|
|
@ -34,8 +37,8 @@
|
|||
[current-error-port eo])
|
||||
(apply system*
|
||||
racket-exe
|
||||
(list* "-C"
|
||||
link-file
|
||||
(list* "-A"
|
||||
work-dir
|
||||
args))))
|
||||
(values (get-output-string o)
|
||||
(get-output-string eo))))
|
||||
|
|
@ -72,6 +75,8 @@
|
|||
;; ----------------------------------------
|
||||
;; check setup errs
|
||||
|
||||
;; This checking has gotten lost. Consider restoring it...
|
||||
#;
|
||||
(run-setup "Racket"
|
||||
#:err "collection not found|not in canonical form")
|
||||
|
||||
|
|
@ -258,4 +263,4 @@
|
|||
;; ----------------------------------------
|
||||
;; clean up
|
||||
|
||||
;(delete-directory/files work-dir)
|
||||
(delete-directory/files work-dir)
|
||||
|
|
|
|||
|
|
@ -12,8 +12,11 @@
|
|||
(module+ test
|
||||
(main))
|
||||
|
||||
(define test1 (build-path (find-system-path 'temp-dir) "pcfd-test1"))
|
||||
(define test2 (build-path (find-system-path 'temp-dir) "pcfd-test2"))
|
||||
|
||||
(define (main)
|
||||
(with-output-to-file "test2" #:exists 'replace (lambda () (write "Get it?\n")))
|
||||
(with-output-to-file test2 #:exists 'replace (lambda () (write "Get it?\n")))
|
||||
|
||||
(define p
|
||||
(place ch
|
||||
|
|
@ -50,25 +53,25 @@
|
|||
))
|
||||
(place-channel-put p (current-output-port))
|
||||
|
||||
(define o (open-output-file "test1" #:exists 'replace))
|
||||
(define o (open-output-file test1 #:exists 'replace))
|
||||
(for ([n (in-range 10000)]) (place-message-allowed? o)) ; make sure checking doesn't dup
|
||||
(write-string "Hello\n" o)
|
||||
(flush-output o)
|
||||
(place-channel-put p o)
|
||||
(place-channel-get p)
|
||||
|
||||
(define i (open-input-file "test2"))
|
||||
(define i (open-input-file test2))
|
||||
(for ([n (in-range 10000)]) (place-message-allowed? i)) ; make sure checking doesn't dup
|
||||
(place-channel-put p i)
|
||||
(close-input-port i)
|
||||
|
||||
(write-string "Hello\n" o)
|
||||
(close-output-port o)
|
||||
(with-input-from-file "test1"
|
||||
(with-input-from-file test1
|
||||
(lambda ()
|
||||
(check-equal? (port->string) "Hello\nBye\nHello\n" "output file contents match")))
|
||||
|
||||
(define o2 (open-output-file "test1" #:exists 'replace))
|
||||
(define o2 (open-output-file test1 #:exists 'replace))
|
||||
(define l (make-list 1024 1))
|
||||
(write-string "HELLO\n" o2)
|
||||
(flush-output o2)
|
||||
|
|
@ -77,17 +80,17 @@
|
|||
|
||||
(write-string "HELLO\n" o2)
|
||||
(close-output-port o2)
|
||||
(with-input-from-file "test1"
|
||||
(with-input-from-file test1
|
||||
(lambda ()
|
||||
(check-equal? (port->string) "HELLO\nBYE\nHELLO\n" "output file contents match")))
|
||||
|
||||
(define i2 (open-input-file "test2"))
|
||||
(define i2 (open-input-file test2))
|
||||
(place-channel-put p (cons i2 l))
|
||||
(close-input-port i2)
|
||||
|
||||
(place-wait p)
|
||||
|
||||
(define i3 (open-input-file "test2"))
|
||||
(define i3 (open-input-file test2))
|
||||
(check-equal? #t #t "cleanup of unreceived port message")
|
||||
(place-channel-put p i3)
|
||||
|
||||
|
|
|
|||
|
|
@ -13,11 +13,13 @@
|
|||
(module+ test
|
||||
(main))
|
||||
|
||||
(define fdt (build-path (find-system-path 'temp-dir) "fdt.rkt"))
|
||||
|
||||
(define (main)
|
||||
(test-case
|
||||
"test file descriptors copied across place channesl"
|
||||
;; write out "fdt.rkt"
|
||||
(with-output-to-file "fdt.rkt" #:exists 'replace (lambda ()
|
||||
;; write out "fdt.rkt"
|
||||
(with-output-to-file fdt #:exists 'replace (lambda ()
|
||||
(display
|
||||
#<<END
|
||||
#lang racket/base
|
||||
|
|
@ -56,7 +58,7 @@ END
|
|||
(close-output-port out)])))
|
||||
|
||||
(let ()
|
||||
(define-values (s o i e) (racket-subprocess #f #f (current-error-port) "fdt.rkt"))
|
||||
(define-values (s o i e) (racket-subprocess #f #f (current-error-port) fdt))
|
||||
(place-channel-put p (list o i))
|
||||
;(close-output-port i)
|
||||
;(close-input-port o)
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#lang racket
|
||||
|
||||
(module+ test
|
||||
(main))
|
||||
(displayln "run as program for tests"))
|
||||
|
||||
;; Runs 3 places perfoming the test suite simultaneously. Each
|
||||
;; thread creates a directory sub<n> to run in, so that filesystem
|
||||
|
|
|
|||
|
|
@ -17,11 +17,12 @@
|
|||
(lambda (x) (void))
|
||||
(lambda ()
|
||||
(define op (open-output-bytes))
|
||||
(call-with-output-file "foo.foo" #:exists 'replace
|
||||
(lambda (op)
|
||||
(close-output-port op)
|
||||
(let-values ([(p pin pout perr) (place* #:out op ch (printf "Hello3\n"))])
|
||||
(place-wait p))))))
|
||||
(call-with-output-file (build-path (find-system-path 'temp-dir) "foo.foo")
|
||||
#:exists 'replace
|
||||
(lambda (op)
|
||||
(close-output-port op)
|
||||
(let-values ([(p pin pout perr) (place* #:out op ch (printf "Hello3\n"))])
|
||||
(place-wait p))))))
|
||||
|
||||
(place-wait (place ch (printf "Hello1\n")))
|
||||
(with-stderr
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user