replacing self modidx refs and tests

original commit: b2b5875e3e
This commit is contained in:
Blake Johnson 2010-10-26 15:45:30 -06:00 committed by Jay McCarthy
parent 8392dd8fa4
commit 969c0f4d58
4 changed files with 85 additions and 0 deletions

View 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))

View 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)))))

View 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)))

View File

@ -0,0 +1,2 @@
#lang racket
5