From 9e2ef482935b7946634e302dfa760b1edf791572 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 30 Apr 2019 18:49:13 -0600 Subject: [PATCH] adjust link and foreign callback tests to work in Racket CS --- .../tests/racket/ffi-orig-place.rkt | 5 ++++- pkgs/racket-test/tests/racket/link.rkt | 22 ++++++++++--------- 2 files changed, 16 insertions(+), 11 deletions(-) diff --git a/pkgs/racket-test/tests/racket/ffi-orig-place.rkt b/pkgs/racket-test/tests/racket/ffi-orig-place.rkt index d6c845a4ee..3df68bd295 100644 --- a/pkgs/racket-test/tests/racket/ffi-orig-place.rkt +++ b/pkgs/racket-test/tests/racket/ffi-orig-place.rkt @@ -7,7 +7,10 @@ ;; Make sure that `#:in-original-place?' doesn't lead to deadlock: (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 ps diff --git a/pkgs/racket-test/tests/racket/link.rkt b/pkgs/racket-test/tests/racket/link.rkt index 01e923567b..c25ae59354 100644 --- a/pkgs/racket-test/tests/racket/link.rkt +++ b/pkgs/racket-test/tests/racket/link.rkt @@ -12,6 +12,8 @@ (eprintf "test failed: ~.s; expected: ~e; actual: ~e\n" expr expect val))) +(define compiled (car (use-compiled-file-paths))) + ;; ---------------------------------------- ;; set up @@ -101,7 +103,7 @@ (test-racket "'m1" '("-l" "c1/m1")) (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" @@ -122,7 +124,7 @@ (test-racket "#" '("-l" "racket/base" "-l" "mzlib/cml" "-e" "(channel)")) (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 @@ -148,9 +150,9 @@ (test-racket "'m3" '("-l" "c1/m3")) (run-setup "c1") -(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 c1-dir "compiled" "m3_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 c1-dir compiled "m3_rkt.zo"))) ;; original "c1" should take precdence over the new addition, ;; just based on the order of addition @@ -162,7 +164,7 @@ (run-setup "c1") ;; 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") (lambda () @@ -201,8 +203,8 @@ (run-setup "c1") -(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 c1-dir compiled "b1_rkt.zo"))) +(test #f (file-exists? (build-path another-c1-dir compiled "b2_rkt.zo"))) ;; ---------------------------------------- ;; subcollections: @@ -225,9 +227,9 @@ (test-racket "'n2" '("-l" "c1/s2/n2")) (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") -(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: