Added a test for #lang planet.

svn: r12104

collects/tests/mzscheme/all.ss

@@ -4,6 +4,7 @@
 (load-relative "scheme-tests.ss")
 (load-relative "mzlib-tests.ss")
 (load-relative "syntax-tests.ss")
+(load-relative "planet.ss")
 (load-in-sandbox "version.ss")
 (load-in-sandbox "net.ss")
 (load-in-sandbox "foreign-test.ss")

collects/tests/mzscheme/planet-stuff/dummy-module.ss

@@ -0,0 +1,3 @@
+#lang planet plt/dummy-package
+
+1 + 2 * (3 + 4)

collects/tests/mzscheme/planet-stuff/dummy-package/lang/reader.ss

@@ -0,0 +1,2 @@
+(module reader syntax/module-reader
+  #:language '(planet plt/dummy-package))

collects/tests/mzscheme/planet-stuff/dummy-package/main.ss

@@ -0,0 +1,36 @@
+#lang scheme
+
+(define-syntax (module-begin stx)
+  (syntax-case stx ()
+    [(_ term ...)
+     (syntax/loc stx
+       (#%module-begin
+        (define result (compute '(term ...)))
+        (provide result)))]))
+
+(define compute
+  (match-lambda
+    [(? rational? const) const]
+    [(list add ...) (compute-additive add)]))
+
+(define compute-additive
+  (match-lambda
+    [(list pre ... '+ post ...)
+     (+ (compute-additive pre)
+        (compute-additive post))]
+    [(list pre ... '- post ...)
+     (- (compute-additive pre)
+        (compute-additive post))]
+    [(list mul ...) (compute-multiplicative mul)]))
+
+(define compute-multiplicative
+  (match-lambda
+    [(list pre ... '* post ...)
+     (* (compute-multiplicative pre)
+        (compute-multiplicative post))]
+    [(list pre ... '/ post ...)
+     (/ (compute-multiplicative pre)
+        (compute-multiplicative post))]
+    [(list term) (compute term)]))
+
+(provide (rename-out [module-begin #%module-begin]))

collects/tests/mzscheme/planet.ss

@@ -0,0 +1,14 @@
+(load-relative "loadtest.ss")
+
+(Section 'planet)
+
+(require planet/util)
+
+;; Testing: #lang planet
+(add-hard-link "plt" "dummy-package.plt" 1 0
+               (string->path "planet-stuff/dummy-package"))
+(test 15 "#lang planet"
+      (dynamic-require "planet-stuff/dummy-module.ss" 'result))
+(remove-hard-link "plt" "dummy-package.plt" 1 0)
+
+(report-errs)