Added file-download-headers tofunction.

untyped · Oct 12, 2010 · ab3d801 · ab3d801
1 parent fd5630d
commit ab3d801
Show file tree

Hide file tree

Showing 20 changed files with 759 additions and 829 deletions.
diff --git a/all-mirrors-tests.ss b/all-mirrors-tests.ss
@@ -9,13 +9,8 @@
 
 ; Tests ------------------------------------------
 
-(define all-mirrors-tests
-  (test-suite "mirrors"
-    all-plain-tests
-    all-csv-tests
-    all-javascript-tests
-    all-xml-tests))
-
-; Provide statements -----------------------------
-
-(provide all-mirrors-tests)
+(define/provide-test-suite all-mirrors-tests
+  all-plain-tests
+  all-csv-tests
+  all-javascript-tests
+  all-xml-tests)
diff --git a/csv/all-csv-tests.ss b/csv/all-csv-tests.ss
@@ -6,13 +6,7 @@
          "response-test.ss"
          "struct-test.ss")
 
-; test-suite
-(define all-csv-tests
-  (test-suite "csv"
-    struct-tests
-    render-tests
-    response-tests))
-
-; Provide statements -----------------------------
-
-(provide all-csv-tests)
+(define/provide-test-suite all-csv-tests
+  struct-tests
+  render-tests
+  response-tests)
diff --git a/csv/render-test.ss b/csv/render-test.ss
@@ -18,41 +18,36 @@
 ; Tests ------------------------------------------
 
 ; test-suite
-(define render-tests
-  (test-suite "render.ss"
-
-    (test-case "atomic values"
-      (check-equal? (csv->string (cell "string"))                 "\"string\"")
-      (check-equal? (csv->string (cell "123"))                    "\"123\"")
-      (check-equal? (csv->string (cell "0123"))                   "\"0123\"")
-      (check-equal? (csv->string (cell 'symbol))                  "\"symbol\"")
-      (check-equal? (csv->string (cell 123.456))                  "123.456")
-      (check-equal? (csv->string (cell #t))                       "yes")
-      (check-equal? (csv->string (cell #f))                       "")
-      (check-equal? (csv->string (cell #"bytes"))                 "\"bytes\"")
-      (check-equal? (csv->string (cell (string->url "/u/r/l")))   "\"/u/r/l\"")
-      (check-equal? (csv->string (cell "\"string\" with quotes")) "\"\"\"string\"\" with quotes\"")
-      ; Times are rendered in the correct immediate time zone:
-      (check-equal? (csv->string (cell utc-winter-date)) "\"2003-02-01 12:34:56\"" "time-utc (GMT)")
-      (check-equal? (csv->string (cell tai-winter-date)) "\"2003-02-01 12:34:56\"" "time-utc (GMT)")
-      (check-equal? (csv->string (cell utc-summer-date)) "\"2003-07-01 12:34:56\"" "time-utc (BST)")
-      (check-equal? (csv->string (cell tai-summer-date)) "\"2003-07-01 12:34:56\"" "time-utc (BST)")
-      (parameterize ([current-tz "PST8PDT"])
-        (check-equal? (csv->string (cell utc-winter-date)) "\"2003-02-01 04:34:56\"" "time-utc (PST)")
-        (check-equal? (csv->string (cell tai-winter-date)) "\"2003-02-01 04:34:56\"" "time-utc (PST)")
-        (check-equal? (csv->string (cell utc-summer-date)) "\"2003-07-01 04:34:56\"" "time-utc (PDT)")
-        (check-equal? (csv->string (cell tai-summer-date)) "\"2003-07-01 04:34:56\"" "time-utc (PDT)")))
-
-    (test-equal? "single row"
-      (csv->string (row (cell 1) (cell "2") (cell 3)))
-      "1,\"2\",3")
-
-    (test-equal? "multiple rows"
-      (csv->string (sheet (row (cell 1) (cell 2) (cell 3))
-                          (row (cell 4) (cell 5) (cell 6))
-                          (row (cell 7) (cell 8) (cell 9))))
-      (format "1,2,3~n4,5,6~n7,8,9"))))
-
-; Provide statements -----------------------------
-
-(provide render-tests)
+(define/provide-test-suite render-tests
+
+  (test-case "atomic values"
+    (check-equal? (csv->string (cell "string"))                 "\"string\"")
+    (check-equal? (csv->string (cell "123"))                    "\"123\"")
+    (check-equal? (csv->string (cell "0123"))                   "\"0123\"")
+    (check-equal? (csv->string (cell 'symbol))                  "\"symbol\"")
+    (check-equal? (csv->string (cell 123.456))                  "123.456")
+    (check-equal? (csv->string (cell #t))                       "yes")
+    (check-equal? (csv->string (cell #f))                       "")
+    (check-equal? (csv->string (cell #"bytes"))                 "\"bytes\"")
+    (check-equal? (csv->string (cell (string->url "/u/r/l")))   "\"/u/r/l\"")
+    (check-equal? (csv->string (cell "\"string\" with quotes")) "\"\"\"string\"\" with quotes\"")
+    ; Times are rendered in the correct immediate time zone:
+    (check-equal? (csv->string (cell utc-winter-date)) "\"2003-02-01 12:34:56\"" "time-utc (GMT)")
+    (check-equal? (csv->string (cell tai-winter-date)) "\"2003-02-01 12:34:56\"" "time-utc (GMT)")
+    (check-equal? (csv->string (cell utc-summer-date)) "\"2003-07-01 12:34:56\"" "time-utc (BST)")
+    (check-equal? (csv->string (cell tai-summer-date)) "\"2003-07-01 12:34:56\"" "time-utc (BST)")
+    (parameterize ([current-tz "PST8PDT"])
+      (check-equal? (csv->string (cell utc-winter-date)) "\"2003-02-01 04:34:56\"" "time-utc (PST)")
+      (check-equal? (csv->string (cell tai-winter-date)) "\"2003-02-01 04:34:56\"" "time-utc (PST)")
+      (check-equal? (csv->string (cell utc-summer-date)) "\"2003-07-01 04:34:56\"" "time-utc (PDT)")
+      (check-equal? (csv->string (cell tai-summer-date)) "\"2003-07-01 04:34:56\"" "time-utc (PDT)")))
+
+  (test-equal? "single row"
+    (csv->string (row (cell 1) (cell "2") (cell 3)))
+    "1,\"2\",3")
+
+  (test-equal? "multiple rows"
+    (csv->string (sheet (row (cell 1) (cell 2) (cell 3))
+                        (row (cell 4) (cell 5) (cell 6))
+                        (row (cell 7) (cell 8) (cell 9))))
+    (format "1,2,3~n4,5,6~n7,8,9")))
diff --git a/csv/struct-test.ss b/csv/struct-test.ss
@@ -6,21 +6,16 @@
 ; Tests ----------------------------------------
 
 ; test-suite
-(define struct-tests
-  (test-suite "struct.ss"
-
-    (test-equal? "single row with list arguments"
-      (row (cell 1)
-           (list (cell 2)
-                 (list (cell 3))
-                 (cell 4))
-           (cell 5))
-      (row (cell 1)
-           (cell 2) 
-           (cell 3)
-           (cell 4)
-           (cell 5)))))
-
-; Provide statements ---------------------------
-
-(provide struct-tests)
+(define/provide-test-suite struct-tests
+
+  (test-equal? "single row with list arguments"
+    (row (cell 1)
+         (list (cell 2)
+               (list (cell 3))
+               (cell 4))
+         (cell 5))
+    (row (cell 1)
+         (cell 2) 
+         (cell 3)
+         (cell 4)
+         (cell 5))))
diff --git a/javascript/all-javascript-tests.ss b/javascript/all-javascript-tests.ss
@@ -11,17 +11,12 @@
          "javascript-registry-test.ss"
          "sexp/module-test.ss")
 
-(define all-javascript-tests
-  (test-suite "javascript"
-    op-tests
-    quote-tests
-    lang-tests
-    syntax-tests
-    #;render-tests
-    response-tests
-    javascript-registry-tests
-    module-tests))
-
-; Provide statements -----------------------------
-
-(provide all-javascript-tests)
+(define/provide-test-suite all-javascript-tests
+  op-tests
+  quote-tests
+  lang-tests
+  syntax-tests
+  #;render-tests
+  response-tests
+  javascript-registry-tests
+  module-tests)
diff --git a/javascript/lang-test.ss b/javascript/lang-test.ss
@@ -23,72 +23,71 @@
 
 ; Tests ------------------------------------------
 
-(define lang-tests
-  (test-suite "lang.ss"
-
-    (test-case "js:var"
-      (check-exn exn:fail:contract? js:var "no args")
-      (check-equal? (apply js:var syms)
-                    (make-VariableDeclaration #f (map (cut make-VariableInitializer #f <> <>) ids '(#f #f #f)))
-                    "no initializers")
-      (check-equal? (apply js:var (map js:init syms numbers))
-                    (make-VariableDeclaration #f (map (cut make-VariableInitializer #f <> <>) ids numeric-lits))
-                    "initializers"))
-
-    (test-case "js:begin"
-      (check-equal? (js:begin)
-                    (make-BeginStatement #f (list))
-                    "no args")
-      (check-equal? (js:begin 1 2 3)
-                    (make-BeginStatement #f (map (cut make-ExpressionStatement #f <>) numeric-lits))
-                    "multiple args"))
-
-    (test-case "js:block"
-      (check-equal? (js:block)
-                    (make-BlockStatement #f null)
-                    "no args")
-      (check-equal? (js:block 1 2 3)
-                    (make-BlockStatement #f (map (cut make-ExpressionStatement #f <>) numeric-lits))
-                    "args"))
-
-    (test-case "js:if"
-      (check-equal? (apply js:if numbers)
-                    (make-IfStatement #f
-                                      (make-NumericLiteral #f 1) 
-                                      (make-ExpressionStatement #f (make-NumericLiteral #f 2))
-                                      (make-ExpressionStatement #f (make-NumericLiteral #f 3)))))
-
-    (test-case "js:do"
-      (check-equal? (js:do 1 #:while 2)
-                    (make-DoWhileStatement #f
-                                           (make-ExpressionStatement #f (make-NumericLiteral #f 1))
-                                           (make-NumericLiteral #f 2))))
-
-    (test-case "js:while"
-      (check-equal? (js:while 1 2)
-                    (make-WhileStatement #f
-                                         (make-NumericLiteral #f 1)
-                                         (make-ExpressionStatement #f (make-NumericLiteral #f 2)))))
-
-    (test-case "js:for-in"
-      (check-not-exn
-        (lambda ()
-          (js:for-in (js:var 'key) 
-                     (js:object (js:field 'a 1)
-                                (js:field 'b 2)
-                                (js:field 'c 3))
-                     (js:call 'alert (js:id 'key))))
-        "single iterator variable")
-      (check-exn exn:fail:contract?
-        (lambda ()
-          (js:for-in (js:var 'key 'val)
-                     (js:object (js:field 'a 1)
-                                (js:field 'b 2)
-                                (js:field 'c 3))
-                     (js:call 'alert (js:id 'key))))
-        "multiple iterator variables"))
-
-    #|
+(define/provide-test-suite lang-tests
+
+  (test-case "js:var"
+    (check-exn exn:fail:contract? js:var "no args")
+    (check-equal? (apply js:var syms)
+                  (make-VariableDeclaration #f (map (cut make-VariableInitializer #f <> <>) ids '(#f #f #f)))
+                  "no initializers")
+    (check-equal? (apply js:var (map js:init syms numbers))
+                  (make-VariableDeclaration #f (map (cut make-VariableInitializer #f <> <>) ids numeric-lits))
+                  "initializers"))
+
+  (test-case "js:begin"
+    (check-equal? (js:begin)
+                  (make-BeginStatement #f (list))
+                  "no args")
+    (check-equal? (js:begin 1 2 3)
+                  (make-BeginStatement #f (map (cut make-ExpressionStatement #f <>) numeric-lits))
+                  "multiple args"))
+
+  (test-case "js:block"
+    (check-equal? (js:block)
+                  (make-BlockStatement #f null)
+                  "no args")
+    (check-equal? (js:block 1 2 3)
+                  (make-BlockStatement #f (map (cut make-ExpressionStatement #f <>) numeric-lits))
+                  "args"))
+
+  (test-case "js:if"
+    (check-equal? (apply js:if numbers)
+                  (make-IfStatement #f
+                                    (make-NumericLiteral #f 1) 
+                                    (make-ExpressionStatement #f (make-NumericLiteral #f 2))
+                                    (make-ExpressionStatement #f (make-NumericLiteral #f 3)))))
+
+  (test-case "js:do"
+    (check-equal? (js:do 1 #:while 2)
+                  (make-DoWhileStatement #f
+                                         (make-ExpressionStatement #f (make-NumericLiteral #f 1))
+                                         (make-NumericLiteral #f 2))))
+
+  (test-case "js:while"
+    (check-equal? (js:while 1 2)
+                  (make-WhileStatement #f
+                                       (make-NumericLiteral #f 1)
+                                       (make-ExpressionStatement #f (make-NumericLiteral #f 2)))))
+
+  (test-case "js:for-in"
+    (check-not-exn
+      (lambda ()
+        (js:for-in (js:var 'key) 
+                   (js:object (js:field 'a 1)
+                              (js:field 'b 2)
+                              (js:field 'c 3))
+                   (js:call 'alert (js:id 'key))))
+      "single iterator variable")
+    (check-exn exn:fail:contract?
+      (lambda ()
+        (js:for-in (js:var 'key 'val)
+                   (js:object (js:field 'a 1)
+                              (js:field 'b 2)
+                              (js:field 'c 3))
+                   (js:call 'alert (js:id 'key))))
+      "multiple iterator variables"))
+
+  #|
     (test-case "js:for" (fail "Not implemented."))
     (test-case "js:for-in" (fail "Not implemented."))
     (test-case "js:break" (fail "Not implemented."))
@@ -118,8 +117,4 @@
     (test-case "js:call" (fail "Not implemented."))
     (test-case "js:id" (fail "Not implemented."))
     |#
-    ))
-
-; Provide statements -----------------------------
-
-(provide lang-tests)
+  )
diff --git a/javascript/op-test.ss b/javascript/op-test.ss
@@ -3,26 +3,19 @@
 (require "../test-base.ss"
          "op.ss")
 
-(define op-tests
-  (test-suite "op.ss"
-
-    (test-case "prefix-operator?"
-      (check-true (prefix-operator? '!) "!"))
-
-    (test-case "postfix-operator?"
-      (check-true (postfix-operator? '++) "++")
-      (check-false (postfix-operator? '!) "!"))
-
-    (test-case "infix-operator?"
-      (check-true (infix-operator? '==) "==")
-      (check-false (infix-operator? '=) "="))
-
-    (test-case "assignment-operator?"
-      (check-true (assignment-operator? '=) "=")
-      (check-false (assignment-operator? '==) "=="))
-
-    ))
-
-; Provide statements -----------------------------
-
-(provide op-tests)
+(define/provide-test-suite op-tests
+
+  (test-case "prefix-operator?"
+    (check-true (prefix-operator? '!) "!"))
+
+  (test-case "postfix-operator?"
+    (check-true (postfix-operator? '++) "++")
+    (check-false (postfix-operator? '!) "!"))
+
+  (test-case "infix-operator?"
+    (check-true (infix-operator? '==) "==")
+    (check-false (infix-operator? '=) "="))
+
+  (test-case "assignment-operator?"
+    (check-true (assignment-operator? '=) "=")
+    (check-false (assignment-operator? '==) "==")))
diff --git a/javascript/quote-test.ss b/javascript/quote-test.ss
@@ -4,8 +4,7 @@
          "quote.ss"
          "struct.ss")
 
-(define quote-tests
-  (test-suite "quote.ss"
+(define/provide-test-suite quote-tests
 
     (test-case "quote-id"
       (check-equal? (quote-identifier (make-Identifier #f 'a)) (make-Identifier #f 'a) "id")
@@ -52,10 +51,4 @@
     (test-case "wrap-block: multiple statements"
       (check-equal? (wrap-block (list 'x 'y)) 
                     (make-BlockStatement #f (list (make-ExpressionStatement #f (make-StringLiteral #f "x"))
-                                                  (make-ExpressionStatement #f (make-StringLiteral #f "y"))))))
-
-    ))
-
-; Provide statements -----------------------------
-
-(provide quote-tests)
+                                                  (make-ExpressionStatement #f (make-StringLiteral #f "y")))))))