suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

adjust link and foreign callback tests to work in Racket CS

Browse Source
This commit is contained in:
Matthew Flatt 2019-04-30 18:49:13 -06:00
parent 1de69c4d37
commit 9e2ef48293
2 changed files with 16 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
pkgs/racket-test/tests/racket/ffi-orig-place.rkt
View File

@ -7,7 +7,10 @@
;; Make sure that `#:in-original-place?' doesn't lead to deadlock: ;; Make sure that `#:in-original-place?' doesn't lead to deadlock:
(define scheme_malloc_atomic (define scheme_malloc_atomic
(get-ffi-obj 'GC_malloc_atomic #f (_fun #:in-original-place? #t _long -> _pointer))) (get-ffi-obj 'GC_malloc_atomic #f (_fun #:in-original-place? #t _long -> _pointer)
(lambda ()
;; Try something that will often work with CS; the leak doesn't matter
(get-ffi-obj 'malloc #f (_fun #:in-original-place? #t _long -> _pointer)))))
(define (x-main) (define (x-main)
(define ps (define ps

22
pkgs/racket-test/tests/racket/link.rkt
View File

@ -12,6 +12,8 @@
(eprintf "test failed: ~.s; expected: ~e; actual: ~e\n" (eprintf "test failed: ~.s; expected: ~e; actual: ~e\n"
expr expect val))) expr expect val)))
(define compiled (car (use-compiled-file-paths)))
;; ---------------------------------------- ;; ----------------------------------------
;; set up ;; set up
@ -101,7 +103,7 @@
(test-racket "'m1" '("-l" "c1/m1")) (test-racket "'m1" '("-l" "c1/m1"))
(run-setup "c1") (run-setup "c1")
(test #t (file-exists? (build-path c1-dir "compiled" "m1_rkt.zo"))) (test #t (file-exists? (build-path c1-dir compiled "m1_rkt.zo")))
;; ---------------------------------------- ;; ----------------------------------------
;; splicing with "mzlib" ;; splicing with "mzlib"
@ -122,7 +124,7 @@
(test-racket "#<channel>" '("-l" "racket/base" "-l" "mzlib/cml" "-e" "(channel)")) (test-racket "#<channel>" '("-l" "racket/base" "-l" "mzlib/cml" "-e" "(channel)"))
(run-setup "mzlib" #:no-docs? #t) (run-setup "mzlib" #:no-docs? #t)
(test #t (file-exists? (build-path mzlib-dir "compiled" "m1_rkt.zo"))) (test #t (file-exists? (build-path mzlib-dir compiled "m1_rkt.zo")))
;; ---------------------------------------- ;; ----------------------------------------
;; splicing via new root directory ;; splicing via new root directory
@ -148,9 +150,9 @@
(test-racket "'m3" '("-l" "c1/m3")) (test-racket "'m3" '("-l" "c1/m3"))
(run-setup "c1") (run-setup "c1")
(test #t (file-exists? (build-path c1-dir "compiled" "m1_rkt.zo"))) (test #t (file-exists? (build-path c1-dir compiled "m1_rkt.zo")))
(test #t (file-exists? (build-path another-c1-dir "compiled" "m2_rkt.zo"))) (test #t (file-exists? (build-path another-c1-dir compiled "m2_rkt.zo")))
(test #t (file-exists? (build-path c1-dir "compiled" "m3_rkt.zo"))) (test #t (file-exists? (build-path c1-dir compiled "m3_rkt.zo")))
;; original "c1" should take precdence over the new addition, ;; original "c1" should take precdence over the new addition,
;; just based on the order of addition ;; just based on the order of addition
@ -162,7 +164,7 @@
(run-setup "c1") (run-setup "c1")
;; questionable: maybe modules unreachable via `require' shouldn't be compiled: ;; questionable: maybe modules unreachable via `require' shouldn't be compiled:
(test #t (file-exists? (build-path another-c1-dir "compiled" "m3_rkt.zo"))) (test #t (file-exists? (build-path another-c1-dir compiled "m3_rkt.zo")))
(with-output-to-file (build-path another-c1-dir "m4.rkt") (with-output-to-file (build-path another-c1-dir "m4.rkt")
(lambda () (lambda ()
@ -201,8 +203,8 @@
(run-setup "c1") (run-setup "c1")
(test #f (file-exists? (build-path c1-dir "compiled" "b1_rkt.zo"))) (test #f (file-exists? (build-path c1-dir compiled "b1_rkt.zo")))
(test #f (file-exists? (build-path another-c1-dir "compiled" "b2_rkt.zo"))) (test #f (file-exists? (build-path another-c1-dir compiled "b2_rkt.zo")))
;; ---------------------------------------- ;; ----------------------------------------
;; subcollections: ;; subcollections:
@ -225,9 +227,9 @@
(test-racket "'n2" '("-l" "c1/s2/n2")) (test-racket "'n2" '("-l" "c1/s2/n2"))
(run-setup "c1/s1") (run-setup "c1/s1")
(test #t (file-exists? (build-path c1/s1-dir "compiled" "n1_rkt.zo"))) (test #t (file-exists? (build-path c1/s1-dir compiled "n1_rkt.zo")))
(run-setup "c1/s2") (run-setup "c1/s2")
(test #t (file-exists? (build-path c1/s2-dir "compiled" "n2_rkt.zo"))) (test #t (file-exists? (build-path c1/s2-dir compiled "n2_rkt.zo")))
;; ---------------------------------------- ;; ----------------------------------------
;; sandbox: ;; sandbox: