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

fix "foreign-test.rktl" to work on Windows

Browse Source
This commit is contained in:
Matthew Flatt 2018-02-21 13:15:04 -07:00
parent 1ea340144a
commit 38d717e98e
1 changed files with 12 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
pkgs/racket-test-core/tests/racket/foreign-test.rktl
View File

@ -541,11 +541,21 @@
(memcpy p #"hi, all!" 8) (memcpy p #"hi, all!" 8)
(test #"hi, all!" cast p _pointer (_bytes o 8)) (test #"hi, all!" cast p _pointer (_bytes o 8))
(test #"hi, all!" cast p _pointer (_bytes/nul-terminated o 8))) (test #"hi, all!" cast p _pointer (_bytes/nul-terminated o 8)))
(let* ([strdup (get-ffi-obj 'strdup #f (_fun _bytes/nul-terminated -> _pointer))] (let* ([strdup (get-ffi-obj (if (eq? 'windows (system-type))
'_strdup
'strdup)
(if (eq? 'windows (system-type))
(ffi-lib "msvcrt.dll")
#f)
(_fun _bytes/nul-terminated -> _pointer))]
[p (strdup #"howdy...")]) [p (strdup #"howdy...")])
(test #"howdy..." cast p _pointer _bytes) (test #"howdy..." cast p _pointer _bytes)
(test #"howdy..." cast p _pointer _bytes/nul-terminated) (test #"howdy..." cast p _pointer _bytes/nul-terminated)
(free p)) (let ([free (if (eq? 'windows (system-type))
;; get `free` consistent with `_strdup`:
(get-ffi-obj 'free (ffi-lib "msvcrt.dll") (_fun _pointer -> _void))
free)])
(free p)))
;; Test equality and hashing of c pointers: ;; Test equality and hashing of c pointers:
(let ([seventeen1 (cast 17 _intptr _pointer)] (let ([seventeen1 (cast 17 _intptr _pointer)]