From b2b5875e3ebdf5a1f173c72f4d84707c9a3484d0 Mon Sep 17 00:00:00 2001
From: Blake Johnson <blake.johnson@byu.edu>
Date: Tue, 26 Oct 2010 15:45:30 -0600
Subject: [PATCH] replacing self modidx refs and tests

---
 .../compiler/demodularizer/replace-modidx.rkt | 25 +++++++++
 .../compiler/demodularizer/demod-test.rkt     | 53 +++++++++++++++++++
 .../compiler/demodularizer/tests/kernel-5.rkt |  5 ++
 .../compiler/demodularizer/tests/racket-5.rkt |  2 +
 4 files changed, 85 insertions(+)
 create mode 100644 collects/compiler/demodularizer/replace-modidx.rkt
 create mode 100644 collects/tests/compiler/demodularizer/demod-test.rkt
 create mode 100644 collects/tests/compiler/demodularizer/tests/kernel-5.rkt
 create mode 100644 collects/tests/compiler/demodularizer/tests/racket-5.rkt

diff --git a/collects/compiler/demodularizer/replace-modidx.rkt b/collects/compiler/demodularizer/replace-modidx.rkt
new file mode 100644
index 0000000000..7ad45cbc56
--- /dev/null
+++ b/collects/compiler/demodularizer/replace-modidx.rkt
@@ -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))
diff --git a/collects/tests/compiler/demodularizer/demod-test.rkt b/collects/tests/compiler/demodularizer/demod-test.rkt
new file mode 100644
index 0000000000..ed29ff1f3e
--- /dev/null
+++ b/collects/tests/compiler/demodularizer/demod-test.rkt
@@ -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)))))
\ No newline at end of file
diff --git a/collects/tests/compiler/demodularizer/tests/kernel-5.rkt b/collects/tests/compiler/demodularizer/tests/kernel-5.rkt
new file mode 100644
index 0000000000..2cee709c7f
--- /dev/null
+++ b/collects/tests/compiler/demodularizer/tests/kernel-5.rkt
@@ -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)))
\ No newline at end of file
diff --git a/collects/tests/compiler/demodularizer/tests/racket-5.rkt b/collects/tests/compiler/demodularizer/tests/racket-5.rkt
new file mode 100644
index 0000000000..a48b41da12
--- /dev/null
+++ b/collects/tests/compiler/demodularizer/tests/racket-5.rkt
@@ -0,0 +1,2 @@
+#lang racket
+5
\ No newline at end of file