diff --git a/collects/tests/mzscheme/all.ss b/collects/tests/mzscheme/all.ss index b2a713926b..338ede0b2b 100644 --- a/collects/tests/mzscheme/all.ss +++ b/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") diff --git a/collects/tests/mzscheme/planet-stuff/dummy-module.ss b/collects/tests/mzscheme/planet-stuff/dummy-module.ss new file mode 100644 index 0000000000..21cbe9666b --- /dev/null +++ b/collects/tests/mzscheme/planet-stuff/dummy-module.ss @@ -0,0 +1,3 @@ +#lang planet plt/dummy-package + +1 + 2 * (3 + 4) \ No newline at end of file diff --git a/collects/tests/mzscheme/planet-stuff/dummy-package/lang/reader.ss b/collects/tests/mzscheme/planet-stuff/dummy-package/lang/reader.ss new file mode 100644 index 0000000000..0b94d9d708 --- /dev/null +++ b/collects/tests/mzscheme/planet-stuff/dummy-package/lang/reader.ss @@ -0,0 +1,2 @@ +(module reader syntax/module-reader + #:language '(planet plt/dummy-package)) diff --git a/collects/tests/mzscheme/planet-stuff/dummy-package/main.ss b/collects/tests/mzscheme/planet-stuff/dummy-package/main.ss new file mode 100644 index 0000000000..f2fc073d1a --- /dev/null +++ b/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])) diff --git a/collects/tests/mzscheme/planet.ss b/collects/tests/mzscheme/planet.ss new file mode 100644 index 0000000000..d8ef082240 --- /dev/null +++ b/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)