Permalink
Browse files

added some tests for case-lambda

  • Loading branch information...
1 parent 766366f commit 8058bd554fca2d874eb0a8c95c85f3fb3a07f226 Danny Yoo committed Aug 16, 2010
@@ -270,6 +270,7 @@
(define body (third (stx-e expr)))]
(compile-lambda-expression empty args body env a-pinfo))]
+ ;; (case-lambda [clause] ...)
[(stx-begins-with? expr 'case-lambda)
(let ([clauses (rest (stx-e expr))])
(compile-case-lambda-expression clauses env a-pinfo))]
@@ -775,6 +776,19 @@
env
(reverse args))))]
+ ;; (case-lambda [clause] ...)
+ [(stx-begins-with? expr 'case-lambda)
+ (let ([clauses (rest (stx-e expr))])
+ (apply append
+ (map (lambda (a-clause)
+ (let ([args (first (stx-e a-clause))]
+ [body (second (stx-e a-clause))])
+ (loop body (foldl (lambda (id env)
+ (env-push-local env id))
+ env
+ (reverse args)))))
+ clauses)))]
+
;; Quoted datums
[(stx-begins-with? expr 'quote)
@@ -316,6 +316,8 @@ var Evaluator = (function() {
};
+
+ // getMessageFromExn: exn -> (or string dom)
Evaluator.prototype.getMessageFromExn = function(exn) {
if (typeof(exn) === 'undefined') {
// We should never get here
@@ -54,7 +54,11 @@ var reportError = function(exn) {
if (exn.domMessage) {
domElt.appendChild(exn.domMessage);
} else {
- domElt.appendChild(document.createTextNode(evaluator.getMessageFromExn(exn)+""));
+ var msg = evaluator.getMessageFromExn(exn);
+ if (typeof(msg) === 'string') {
+ msg = document.createTextNode(msg);
+ }
+ domElt.appendChild(msg);
}
var stacktrace = evaluator.getTraceFromExn(exn);
@@ -0,0 +1,52 @@
+#lang scheme/base
+
+(require "../../serve.ss"
+ "../../stx-helpers.ss")
+
+(require (for-syntax scheme/base))
+
+
+;; I should be able to use the compiler on these expressions and test the result of evaluating
+;; them.
+
+(define test-program/rev '())
+
+
+;; compile-and-check: expr expected -> void
+(define (run-tests)
+ (compile-and-serve
+ (reverse test-program/rev)
+ "test"))
+
+(define (add-test* expr expected)
+ (with-syntax ([e1 expr]
+ [e2 expected])
+ (set! test-program/rev (cons (syntax->stx #'(check-expect e1 e2))
+ test-program/rev))))
+
+(define-syntax (add-test stx)
+ (syntax-case stx ()
+ [(_ e1 e2)
+ #'(add-test* #'e1 #'e2)]))
+
+
+
+
+
+(add-test (let ([x (case-lambda
+ [(x) (list x)]
+ [(x y) (list y x)])])
+ (list (x 3)
+ (x 3 4)))
+
+ '((3) (4 3)))
+
+(add-test (let ([x (case-lambda
+ [() (list 'empty-accepted)])])
+ (x))
+
+ '(empty-accepted))
+
+
+
+(run-tests)
View
@@ -36,7 +36,9 @@
;; compile-and-serve: (listof stx) -> void
;; Generate a web site that compiles and evaluates the program.
-(define (compile-and-serve source-code [program-name "unknown"])
+(define (compile-and-serve source-code
+ [program-name "unknown"]
+ #:launch-browser-to-program? (launch-browser-to-program? #f))
(let ([source-dir (current-directory)])
(with-temporary-directory
(lambda (dir)
@@ -130,13 +132,18 @@
(let ([port (tcp-listen portno 4 #t #f)])
(tcp-close port)
portno)))])
- (serve/servlet dispatcher
- #:port portno
- #:listen-ip #f
- #:servlet-path "/choose"
- #:servlet-regexp
- #rx"(^/networkProxy)|(^/choose)|(^/generate-apk)|(^/generate-js-zip)"
- #:extra-files-paths (list javascript-support dir)))))))))
+ (if launch-browser-to-program?
+ (serve/servlet dispatcher
+ #:port portno
+ #:listen-ip #f
+ #:extra-files-paths (list javascript-support dir))
+ (serve/servlet dispatcher
+ #:port portno
+ #:listen-ip #f
+ #:servlet-path "/choose"
+ #:servlet-regexp
+ #rx"(^/networkProxy)|(^/choose)|(^/generate-apk)|(^/generate-js-zip)"
+ #:extra-files-paths (list javascript-support dir))))))))))
@@ -146,4 +153,7 @@
-(provide/contract [compile-and-serve (((listof stx?)) (string?) . ->* . any)])
+(provide/contract [compile-and-serve (((listof stx?))
+ (string?
+ #:launch-browser-to-program? boolean?)
+ . ->* . any)])

0 comments on commit 8058bd5

Please sign in to comment.