parent
8392dd8fa4
commit
969c0f4d58
25
collects/compiler/demodularizer/replace-modidx.rkt
Normal file
25
collects/compiler/demodularizer/replace-modidx.rkt
Normal file
|
@ -0,0 +1,25 @@
|
|||
#lang racket
|
||||
(require unstable/struct
|
||||
"util.rkt")
|
||||
(provide replace-modidx)
|
||||
|
||||
(define (replace-modidx expr self-modidx)
|
||||
(define (inner-update e)
|
||||
(match e
|
||||
[(app prefab-struct-key (and key (not #f)))
|
||||
(apply make-prefab-struct key
|
||||
(map update
|
||||
(struct->list e)))]
|
||||
[(? module-path-index?)
|
||||
(define-values (path mpi) (module-path-index-split e))
|
||||
(if (not path)
|
||||
self-modidx
|
||||
(module-path-index-join path (update mpi)))]
|
||||
[(cons a b)
|
||||
(cons (update a) (update b))]
|
||||
[(? vector?)
|
||||
(vector-map update e)]
|
||||
[else e]))
|
||||
(define-values (first-update update)
|
||||
(build-form-memo inner-update))
|
||||
(first-update expr))
|
53
collects/tests/compiler/demodularizer/demod-test.rkt
Normal file
53
collects/tests/compiler/demodularizer/demod-test.rkt
Normal file
|
@ -0,0 +1,53 @@
|
|||
#lang racket
|
||||
(require tests/eli-tester
|
||||
racket/runtime-path)
|
||||
|
||||
(define (capture-output command . args)
|
||||
(define o (open-output-string))
|
||||
(define e (open-output-string))
|
||||
(parameterize ([current-input-port (open-input-string "")]
|
||||
[current-output-port o]
|
||||
[current-error-port e])
|
||||
(apply system* command args))
|
||||
(values (get-output-string o) (get-output-string e)))
|
||||
|
||||
(define (test-on-program filename)
|
||||
; run modular program, capture output
|
||||
(define-values (modular-output modular-error)
|
||||
(capture-output (find-executable-path "racket") filename))
|
||||
|
||||
; demodularize
|
||||
(parameterize ([current-input-port (open-input-string "")])
|
||||
(system* (find-executable-path "raco") "demod" filename))
|
||||
|
||||
(define demod-filename
|
||||
(path->string
|
||||
(path-add-suffix filename #".merged.rkt")))
|
||||
|
||||
; run whole program
|
||||
(define-values (whole-output whole-error)
|
||||
(capture-output (find-executable-path "racket") demod-filename))
|
||||
|
||||
(display whole-error)
|
||||
|
||||
; compare output
|
||||
(test
|
||||
#:failure-prefix (format "~a stdout" filename)
|
||||
whole-output => modular-output
|
||||
#:failure-prefix (format "~a stderr" filename)
|
||||
whole-error => modular-error))
|
||||
|
||||
(define-runtime-path tests "tests")
|
||||
|
||||
(define (modular-program? filename)
|
||||
(and (not (regexp-match #rx"merged" filename))
|
||||
(regexp-match #rx"rkt$" filename)))
|
||||
|
||||
(test-on-program "/Users/blake/Development/plt/collects/tests/compiler/demodularizer/tests/racket-5.rkt")
|
||||
|
||||
#;(test
|
||||
(for ([i (in-list (directory-list tests))])
|
||||
(define ip (build-path tests i))
|
||||
(when (modular-program? ip)
|
||||
(printf "Checking ~a\n" ip)
|
||||
(test-on-program (path->string ip)))))
|
5
collects/tests/compiler/demodularizer/tests/kernel-5.rkt
Normal file
5
collects/tests/compiler/demodularizer/tests/kernel-5.rkt
Normal file
|
@ -0,0 +1,5 @@
|
|||
(module kernel-5 '#%kernel
|
||||
(#%require racket/private/map)
|
||||
(define-values (id) (λ (x) x))
|
||||
(define-values (xs) (list 1 2 3 4 5))
|
||||
(map id (map id xs)))
|
2
collects/tests/compiler/demodularizer/tests/racket-5.rkt
Normal file
2
collects/tests/compiler/demodularizer/tests/racket-5.rkt
Normal file
|
@ -0,0 +1,2 @@
|
|||
#lang racket
|
||||
5
|
Loading…
Reference in New Issue
Block a user