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

Added a test for cross-module struct optimization.

Browse Source
This commit is contained in:
Vincent St-Amour 2010-07-08 18:29:02 -04:00
parent 4a8113eac6
commit 4e6fc3154b
5 changed files with 28 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/tests/typed-scheme/optimizer/generic/cross-module-struct.rkt Normal file
View File

@ -0,0 +1,5 @@
#lang typed/scheme #:optimize
;; will be imported by cross-module-struct2
(provide (struct-out x))
(define-struct: x ((x : Integer)))

5
collects/tests/typed-scheme/optimizer/generic/cross-module-struct2.rkt Normal file
View File

@ -0,0 +1,5 @@
#lang typed/scheme #:optimize
(require (file "cross-module-struct.rkt") racket/unsafe/ops)
(define a (make-x 1))
(x-x a)

5
collects/tests/typed-scheme/optimizer/hand-optimized/cross-module-struct.rkt Normal file
View File

@ -0,0 +1,5 @@
#lang typed/scheme #:optimize
;; will be imported by cross-module-struct2
(provide (struct-out x))
(define-struct: x ((x : Integer)))

5
collects/tests/typed-scheme/optimizer/hand-optimized/cross-module-struct2.rkt Normal file
View File

@ -0,0 +1,5 @@
#lang typed/scheme #:optimize
(require (file "cross-module-struct.rkt") racket/unsafe/ops)
(define a (make-x 1))
(unsafe-struct-ref a 0)

11
collects/tests/typed-scheme/optimizer/run.rkt
View File

@ -15,7 +15,8 @@
(match-lambda [(list 'define-values-for-syntax '() _ ...) #f] [_ #t])
(cadddr
(syntax->datum
(parameterize ([current-namespace (make-base-namespace)])
(parameterize ([current-namespace (make-base-namespace)]
[read-accept-reader #t])
(with-handlers
([exn:fail? (lambda (exn)
(printf "~a\n" (exn-message exn))
@ -25,8 +26,12 @@
(define (test gen)
(let-values (((base name _) (split-path gen)))
(or (regexp-match ".*~" name) ; we ignore backup files
(equal? (read-and-expand gen)
(read-and-expand (build-path base "../hand-optimized/" name)))
(equal? (parameterize ([current-load-relative-directory
(build-path here "generic")])
(read-and-expand gen))
(let ((hand-opt-dir (build-path here "hand-optimized")))
(parameterize ([current-load-relative-directory hand-opt-dir])
(read-and-expand (build-path hand-opt-dir name)))))
(begin (printf "~a failed\n\n" name)
#f))))