From 4e6fc3154bd286d3edcd36a25bfc672cc6a0659d Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Thu, 8 Jul 2010 18:29:02 -0400 Subject: [PATCH] Added a test for cross-module struct optimization. --- .../optimizer/generic/cross-module-struct.rkt | 5 +++++ .../optimizer/generic/cross-module-struct2.rkt | 5 +++++ .../optimizer/hand-optimized/cross-module-struct.rkt | 5 +++++ .../optimizer/hand-optimized/cross-module-struct2.rkt | 5 +++++ collects/tests/typed-scheme/optimizer/run.rkt | 11 ++++++++--- 5 files changed, 28 insertions(+), 3 deletions(-) create mode 100644 collects/tests/typed-scheme/optimizer/generic/cross-module-struct.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/cross-module-struct2.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/cross-module-struct.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/cross-module-struct2.rkt diff --git a/collects/tests/typed-scheme/optimizer/generic/cross-module-struct.rkt b/collects/tests/typed-scheme/optimizer/generic/cross-module-struct.rkt new file mode 100644 index 0000000000..7b52b214f6 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/cross-module-struct.rkt @@ -0,0 +1,5 @@ +#lang typed/scheme #:optimize + +;; will be imported by cross-module-struct2 +(provide (struct-out x)) +(define-struct: x ((x : Integer))) diff --git a/collects/tests/typed-scheme/optimizer/generic/cross-module-struct2.rkt b/collects/tests/typed-scheme/optimizer/generic/cross-module-struct2.rkt new file mode 100644 index 0000000000..45a1696e78 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/cross-module-struct2.rkt @@ -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) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/cross-module-struct.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/cross-module-struct.rkt new file mode 100644 index 0000000000..7b52b214f6 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/cross-module-struct.rkt @@ -0,0 +1,5 @@ +#lang typed/scheme #:optimize + +;; will be imported by cross-module-struct2 +(provide (struct-out x)) +(define-struct: x ((x : Integer))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/cross-module-struct2.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/cross-module-struct2.rkt new file mode 100644 index 0000000000..1968590c9e --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/cross-module-struct2.rkt @@ -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) diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt index b4139e25c6..6edd366d63 100644 --- a/collects/tests/typed-scheme/optimizer/run.rkt +++ b/collects/tests/typed-scheme/optimizer/run.rkt @@ -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))))