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

test fixes for Windows

Browse Source
This commit is contained in:
Matthew Flatt 2011-08-20 11:06:09 -06:00 committed by Matthew Flatt
parent 345b06838d
commit a587f047d6
2 changed files with 20 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/racket/filelib.rktl
View File

@ -166,7 +166,7 @@
"stuff") "stuff")
(test (build-path "dir" (if (eq? (system-type) 'windows) "_LOCKstuff" ".LOCKstuff")) (test (build-path "dir" (if (eq? (system-type) 'windows) "_LOCKstuff" ".LOCKstuff"))
make-lock-file-name make-lock-file-name
"dir/stuff") (build-path "dir" "stuff"))
(test (build-path "dir" (if (eq? (system-type) 'windows) "_LOCKstuff" ".LOCKstuff")) (test (build-path "dir" (if (eq? (system-type) 'windows) "_LOCKstuff" ".LOCKstuff"))
make-lock-file-name make-lock-file-name
"dir" "dir"

37
collects/tests/racket/foreign-test.rktl
View File

@ -24,17 +24,18 @@
[studio "c:/Program Files/Microsoft Visual Studio 10.0"] [studio "c:/Program Files/Microsoft Visual Studio 10.0"]
[scommon (concat studio "/Common7")] [scommon (concat studio "/Common7")]
[vc (concat studio "/VC")]) [vc (concat studio "/VC")])
(putenv "PATH" (concat (getenv "PATH") (when (directory-exists? studio)
";" vc "/bin" (putenv "PATH" (concat (getenv "PATH")
";" scommon "/IDE" ";" vc "/bin"
";" scommon "/Tools" ";" scommon "/IDE"
";" scommon "/Tools/bin")) ";" scommon "/Tools"
(putenv "INCLUDE" (concat ";" vc "/include" ";" scommon "/Tools/bin"))
";" vc "/atlmfc/include" (putenv "INCLUDE" (concat ";" vc "/include"
";" vc "/PlatformSDK/Include")) ";" vc "/atlmfc/include"
(putenv "LIB" (concat ";" vc "/lib" ";" vc "/PlatformSDK/Include"))
";" vc "/atlmfc/lib" (putenv "LIB" (concat ";" vc "/lib"
";" vc "/PlatformSDK/lib")))) ";" vc "/atlmfc/lib"
";" vc "/PlatformSDK/lib")))))
(require dynext/compile dynext/link mzlib/etc) (require dynext/compile dynext/link mzlib/etc)
(define delete-test-files (define delete-test-files
@ -332,10 +333,10 @@
(test 107 ptr-ref v _intptr)) (test 107 ptr-ref v _intptr))
;; Test equality and hashing of c pointers: ;; Test equality and hashing of c pointers:
(let ([seventeen1 (cast 17 _long _pointer)] (let ([seventeen1 (cast 17 _intptr _pointer)]
[seventeen2 (cast 17 _long _pointer)] [seventeen2 (cast 17 _intptr _pointer)]
[seventeen3 (ptr-add (cast 13 _long _pointer) 4)] [seventeen3 (ptr-add (cast 13 _intptr _pointer) 4)]
[sixteen (cast 16 _long _pointer)]) [sixteen (cast 16 _intptr _pointer)])
(test #t equal? seventeen1 seventeen2) (test #t equal? seventeen1 seventeen2)
(test #t equal? seventeen1 seventeen3) (test #t equal? seventeen1 seventeen3)
(test #f equal? sixteen seventeen1) (test #f equal? sixteen seventeen1)
@ -349,21 +350,21 @@
;; Check proper handling of offsets: ;; Check proper handling of offsets:
(let () (let ()
(define scheme_make_sized_byte_string (define scheme_make_sized_byte_string
(get-ffi-obj 'scheme_make_sized_byte_string #f (_fun _pointer _long _int -> _scheme))) (get-ffi-obj 'scheme_make_sized_byte_string #f (_fun _pointer _intptr _int -> _scheme)))
;; Non-gcable: ;; Non-gcable:
(let () (let ()
(define p (cast (ptr-add #f 20) _pointer _pointer)) (define p (cast (ptr-add #f 20) _pointer _pointer))
(define d (scheme_make_sized_byte_string (ptr-add p 24) (define d (scheme_make_sized_byte_string (ptr-add p 24)
4 4
0)) 0))
(test 44 values (cast d _pointer _long))) (test 44 values (cast d _pointer _intptr)))
;; GCable: ;; GCable:
(let () (let ()
(define p (cast (ptr-add #f 20) _pointer _gcpointer)) (define p (cast (ptr-add #f 20) _pointer _gcpointer))
(define d (scheme_make_sized_byte_string (ptr-add p 24) (define d (scheme_make_sized_byte_string (ptr-add p 24)
4 4
0)) 0))
(test 44 values (cast d _gcpointer _long)))) (test 44 values (cast d _gcpointer _intptr))))
(delete-test-files) (delete-test-files)