Merge branch 'upstream' into dfsg_clean20150819+dfsg

Conflicts: doc/intro.ur
author: Benjamin Barenblat <bbaren@mit.edu> 2015-08-19 11:02:23 -0400
committer: Benjamin Barenblat <bbaren@mit.edu> 2015-08-19 11:02:23 -0400
commit: 598756dc69f89cf2dd2b889cad63a7a690ae7ed7 (patch)
tree: 5fc521225e717163c30ea494a5839c26725eec2e
parent: 7ea9d17bad72cf2829c75d8d241fafa70b2c9b94 (diff)
parent: fb6e6599b35df9cfa05786772868b1a3d2e58ac3 (diff)
19 files changed, 224 insertions, 53 deletions
diff --git a/CHANGELOG b/CHANGELOG
index 838da410..02e9d754 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,4 +1,15 @@
 ========
+20150819
+========
+
+- Allow mouse and key events for <body>
+- Add HTML 'align' attribute
+- Add onChange handler to radioOption
+- New literal [_LOC_] that is replaced with textual information on location in source file
+- Add a simple 'make test' target
+- Bug fixes and documentation improvements
+
+========
 20150520
 ========
 
diff --git a/Makefile.am b/Makefile.am
index 11f9a132..ab11999e 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -15,7 +15,7 @@ all-local: smlnj mlton
 
 SUBDIRS = src/c
 
-.PHONY: smlnj mlton package reauto
+.PHONY: smlnj mlton package reauto test
 
 smlnj: src/urweb.cm xml/entities.sml
 mlton: bin/urweb
@@ -114,3 +114,17 @@ reauto:
 EXTRA_DIST = demo doc lib/js lib/ur xml \
 	src/coq src/*.sig src/*.sml src/*.mlb src/config.sml.in src/elisp src/*.cm src/sources src/*.grm src/*.lex \
 	CHANGELOG LICENSE urweb.ebuild include/urweb/*.h bin
+
+TESTDB = /tmp/urweb.db
+TESTPID = /tmp/urweb.pid
+
+test:
+	bin/urweb -boot -noEmacs -dbms sqlite -db $(TESTDB) -demo /Demo demo
+	rm -f $(TESTDB)
+	sqlite3 $(TESTDB) < demo/demo.sql
+	demo/demo.exe & echo $$! > $(TESTPID)
+	sleep 1
+	(curl -s 'http://localhost:8080/Demo/Hello/main' | diff tests/hello.html -) || (kill `cat $(TESTPID)`; echo "Test 'Hello' failed"; /bin/false)
+	(curl -s 'http://localhost:8080/Demo/Crud1/create?A=1&B=2&C=3&D=4' | diff tests/crud1.html -) || (kill `cat $(TESTPID)`; echo "Test 'Crud1' failed"; /bin/false)
+	kill `cat $(TESTPID)`
+	echo Tests succeeded.
diff --git a/configure.ac b/configure.ac
index 89620c40..b199cd29 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,4 +1,4 @@
-AC_INIT([urweb], [20150520])
+AC_INIT([urweb], [20150819])
 WORKING_VERSION=0
 AC_USE_SYSTEM_EXTENSIONS
 
diff --git a/doc/manual.tex b/doc/manual.tex
index 1ff3f7aa..5c5e5cbb 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -509,8 +509,8 @@ $$\begin{array}{rrcll}
   &&& \ell & \textrm{constant} \\
   &&& \hat{X} & \textrm{nullary constructor} \\
   &&& \hat{X} \; p & \textrm{unary constructor} \\
-  &&& \{(x = p,)^*\} & \textrm{rigid record pattern} \\
-  &&& \{(x = p,)^+, \ldots\} & \textrm{flexible record pattern} \\
+  &&& \{(X = p,)^*\} & \textrm{rigid record pattern} \\
+  &&& \{(X = p,)^+, \ldots\} & \textrm{flexible record pattern} \\
   &&& p : \tau & \textrm{type annotation} \\
   &&& (p) & \textrm{explicit precedence} \\
   \\
@@ -968,11 +968,11 @@ $$\infer{\Gamma \vdash M.X \; p \leadsto \Gamma'; \overline{[x_i \mapsto \tau'_i
   & \Gamma \vdash p \leadsto \Gamma'; \overline{[x_i \mapsto \tau'_i]}\tau''
 }$$
 
-$$\infer{\Gamma \vdash \{\overline{x = p}\} \leadsto \Gamma_n; \{\overline{x = \tau}\}}{
+$$\infer{\Gamma \vdash \{\overline{X = p}\} \leadsto \Gamma_n; \{\overline{X = \tau}\}}{
   \Gamma_0 = \Gamma
   & \forall i: \Gamma_i \vdash p_i \leadsto \Gamma_{i+1}; \tau_i
 }
-\quad \infer{\Gamma \vdash \{\overline{x = p}, \ldots\} \leadsto \Gamma_n; \$([\overline{x = \tau}] \rc c)}{
+\quad \infer{\Gamma \vdash \{\overline{X = p}, \ldots\} \leadsto \Gamma_n; \$([\overline{X = \tau}] \rc c)}{
   \Gamma_0 = \Gamma
   & \forall i: \Gamma_i \vdash p_i \leadsto \Gamma_{i+1}; \tau_i
 }$$
@@ -1424,7 +1424,7 @@ $$\begin{array}{l}
   \hspace{.1in} \to (\mt{nm} :: \mt{Name} \to \mt{v} :: \mt{K} \to \mt{r} :: \{\mt{K}\} \to [[\mt{nm}] \sim \mt{r}] \Rightarrow \\
   \hspace{.2in} \mt{tf} \; \mt{r} \to \mt{tf} \; ([\mt{nm} = \mt{v}] \rc \mt{r})) \\
   \hspace{.1in} \to \mt{tf} \; [] \\
-  \hspace{.1in} \to \mt{r} :: \{\mt{K}\} \to \mt{folder} \; \mt{r} \to \mt{tf} \; \mt{r}
+  \hspace{.1in} \to \mt{r} ::: \{\mt{K}\} \to \mt{folder} \; \mt{r} \to \mt{tf} \; \mt{r}
 \end{array}$$
 
 For a type-level record $\mt{r}$, a $\mt{folder} \; \mt{r}$ encodes a permutation of $\mt{r}$'s elements.  The $\mt{fold}$ function can be called on a $\mt{folder}$ to iterate over the elements of $\mt{r}$ in that order.  $\mt{fold}$ is parameterized on a type-level function to be used to calculate the type of each intermediate result of folding.  After processing a subset $\mt{r'}$ of $\mt{r}$'s entries, the type of the accumulator should be $\mt{tf} \; \mt{r'}$.  The next two expression arguments to $\mt{fold}$ are the usual step function and initial accumulator, familiar from fold functions over lists.  The final two arguments are the record to fold over and a $\mt{folder}$ for it.
@@ -1861,7 +1861,7 @@ Any SQL query that returns single columns may be turned into a subquery expressi
 
 $$\begin{array}{l}
 \mt{val} \; \mt{sql\_subquery} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \to \mt{nm} ::: \mt{Name} \to \mt{t} ::: \mt{Type} \to \mt{nt} ::: \mt{Type} \\
-\hspace{.1in} \to \mt{nullify} \; \mt{t} \; \mt{nt} \to \mt{sql\_query} \; \mt{tables} \; \mt{agg} \; [\mt{nm} = \mt{t}] \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{nt}
+\hspace{.1in} \to \mt{nullify} \; \mt{t} \; \mt{nt} \to \mt{sql\_query} \; \mt{tables} \; \mt{agg} \; [] \; [\mt{nm} = \mt{t}] \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{nt}
 \end{array}$$
 
 There is also an \cd{IF..THEN..ELSE..} construct that is compiled into standard SQL \cd{CASE} expressions.
@@ -1990,7 +1990,7 @@ $$\begin{array}{l}
   \hspace{.1in} \to \$(\mt{map} \; (\mt{sql\_exp} \; [] \; [] \; []) \; \mt{fields}) \to \mt{dml}
 \end{array}$$
 
-An $\mt{UPDATE}$ command is formed from a choice of which table fields to leave alone and which to change, along with an expression to use to compute the new value of each changed field and a $\mt{WHERE}$ clause.  Note that, in the table environment applied to expressions, the table being updated is hardcoded at the name $\mt{T}$.  The parsing extension for $\mt{UPDATE}$ will elaborate all table-free field references to use table variable $\mt{T}$.
+An $\mt{UPDATE}$ command is formed from a choice of which table fields to leave alone and which to change, along with an expression to use to compute the new value of each changed field and a $\mt{WHERE}$ clause.  Note that, in the table environment applied to expressions, the table being updated is hardcoded at the name $\mt{T}$.  The parsing extension for $\mt{UPDATE}$ will elaborate all table-free field references to use constant table name $\mt{T}$.
 $$\begin{array}{l}
   \mt{val} \; \mt{update} : \mt{unchanged} ::: \{\mt{Type}\} \to \mt{changed} :: \{\mt{Type}\} \to [\mt{changed} \sim \mt{unchanged}] \\
   \hspace{.1in} \Rightarrow \$(\mt{map} \; (\mt{sql\_exp} \; [\mt{T} = \mt{changed} \rc \mt{unchanged}] \; [] \; []) \; \mt{changed}) \\
@@ -2287,11 +2287,12 @@ $$\begin{array}{rrcll}
   \textrm{Tables} & T &::=& x & \textrm{table variable, named locally by its own capitalization} \\
   &&& x \; \mt{AS} \; X & \textrm{table variable, with local name} \\
   &&& x \; \mt{AS} \; \{c\} & \textrm{table variable, with computed local name} \\
-  &&& \{\{e\}\} \; \mt{AS} \; t & \textrm{computed table expression, with local name} \\
+  &&& \{\{e\}\} \; \mt{AS} \; X & \textrm{computed table expression, with local name} \\
   &&& \{\{e\}\} \; \mt{AS} \; \{c\} & \textrm{computed table expression, with computed local name} \\
   \textrm{$\mt{FROM}$ items} & F &::=& T \mid \{\{e\}\} \mid F \; J \; \mt{JOIN} \; F \; \mt{ON} \; E \\
   &&& \mid F \; \mt{CROSS} \; \mt{JOIN} \ F \\
-  &&& \mid (Q) \; \mt{AS} \; t \mid (\{\{e\}\}) \; \mt{AS} \; t \\
+  &&& \mid (Q) \; \mt{AS} \; X \mid (Q) \; \mt{AS} \; \{c\} \\
+  &&& \mid (\{\{e\}\}) \; \mt{AS} \; t \\
   \textrm{Joins} & J &::=& [\mt{INNER}] \\
   &&& \mid [\mt{LEFT} \mid \mt{RIGHT} \mid \mt{FULL}] \; [\mt{OUTER}] \\
   \textrm{SQL expressions} & E &::=& t.f & \textrm{column references} \\
@@ -2313,7 +2314,7 @@ $$\begin{array}{rrcll}
   &&& (E) & \textrm{explicit precedence} \\
   \textrm{Nullary operators} & n &::=& \mt{CURRENT\_TIMESTAMP} \\
   \textrm{Unary operators} & u &::=& \mt{NOT} \\
-  \textrm{Binary operators} & b &::=& \mt{AND} \mid \mt{OR} \mid = \mid \neq \mid < \mid \leq \mid > \mid \geq \\
+  \textrm{Binary operators} & b &::=& \mt{AND} \mid \mt{OR} \mid = \mid \neq \mid < \mid \leq \mid > \mid \geq \mid \mt{LIKE} \\
   \textrm{Aggregate functions} & a &::=& \mt{COUNT} \mid \mt{AVG} \mid \mt{SUM} \mid \mt{MIN} \mid \mt{MAX} \\
   \textrm{Directions} & o &::=& \mt{ASC} \mid \mt{DESC} \mid \{e\} \\
   \textrm{SQL integer} & N &::=& n \mid \{e\} \\
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 56c8d767..ec6ef599 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -811,21 +811,6 @@ val head : unit -> tag [Data = data_attr] html head [] []
 val title : unit -> tag [Data = data_attr] head [] [] []
 val link : unit -> tag [Data = data_attr, Id = id, Rel = string, Typ = string, Href = url, Media = string] head [] [] []
 
-val body : unit -> tag [Data = data_attr, Onload = transaction unit, Onresize = transaction unit, Onunload = transaction unit, Onhashchange = transaction unit]
-                       html body [] []
-con bodyTag = fn (attrs :: {Type}) =>
-                 ctx ::: {Unit} ->
-                 [[Body] ~ ctx] =>
-                    unit -> tag attrs ([Body] ++ ctx) ([Body] ++ ctx) [] []
-con bodyTagStandalone = fn (attrs :: {Type}) =>
-                           ctx ::: {Unit}
-                           -> [[Body] ~ ctx] =>
-                                 unit -> tag attrs ([Body] ++ ctx) [] [] []
-
-val br : bodyTagStandalone [Data = data_attr, Id = id]
-
-con focusEvents = [Onblur = transaction unit, Onfocus = transaction unit]
-
 datatype mouseButton = Left | Right | Middle
 
 type mouseEvent = { ScreenX : int, ScreenY : int, ClientX : int, ClientY : int,
@@ -841,6 +826,24 @@ type keyEvent = { KeyCode : int,
 con keyEvents = map (fn _ :: Unit => keyEvent -> transaction unit)
                         [Onkeydown, Onkeypress, Onkeyup]
 
+val body : unit -> tag ([Data = data_attr, Onload = transaction unit, Onresize = transaction unit, Onunload = transaction unit, Onhashchange = transaction unit]
+                            ++ mouseEvents ++ keyEvents)
+                       html body [] []
+
+con bodyTag = fn (attrs :: {Type}) =>
+                 ctx ::: {Unit} ->
+                 [[Body] ~ ctx] =>
+                    unit -> tag attrs ([Body] ++ ctx) ([Body] ++ ctx) [] []
+con bodyTagStandalone = fn (attrs :: {Type}) =>
+                           ctx ::: {Unit}
+                           -> [[Body] ~ ctx] =>
+                                 unit -> tag attrs ([Body] ++ ctx) [] [] []
+
+val br : bodyTagStandalone [Data = data_attr, Id = id]
+
+con focusEvents = [Onblur = transaction unit, Onfocus = transaction unit]
+
+
 (* Key arguments are character codes. *)
 con resizeEvents = [Onresize = transaction unit]
 con scrollEvents = [Onscroll = transaction unit]
@@ -848,8 +851,8 @@ con scrollEvents = [Onscroll = transaction unit]
 con boxEvents = focusEvents ++ mouseEvents ++ keyEvents ++ resizeEvents ++ scrollEvents
 con tableEvents = focusEvents ++ mouseEvents ++ keyEvents
 
-con boxAttrs = [Data = data_attr, Id = id, Title = string, Role = string] ++ boxEvents
-con tableAttrs = [Data = data_attr, Id = id, Title = string] ++ tableEvents
+con boxAttrs = [Data = data_attr, Id = id, Title = string, Role = string, Align = string] ++ boxEvents
+con tableAttrs = [Data = data_attr, Id = id, Title = string, Align = string] ++ tableEvents
 
 val span : bodyTag boxAttrs
 val div : bodyTag boxAttrs
@@ -1008,7 +1011,7 @@ val remainingFields : postField -> string
 
 con radio = [Body, Radio]
 val radio : formTag (option string) radio [Data = data_attr, Id = id]
-val radioOption : unit -> tag ([Value = string, Checked = bool] ++ boxAttrs) radio [] [] []
+val radioOption : unit -> tag ([Value = string, Checked = bool, Onchange = transaction unit] ++ boxAttrs) radio [] [] []
 
 con select = [Select]
 val select : formTag string select ([Onchange = transaction unit] ++ boxAttrs)
diff --git a/lib/ur/top.ur b/lib/ur/top.ur
index 3250a5a3..e831b4f7 100644
--- a/lib/ur/top.ur
+++ b/lib/ur/top.ur
@@ -410,3 +410,6 @@ fun max [t] ( _ : ord t) (x : t) (y : t) : t =
     if x > y then x else y
 fun min [t] ( _ : ord t) (x : t) (y : t) : t =
     if x < y then x else y
+
+fun assert [a] (cond: bool) (msg: string) (loc: string) (x:a): a =
+  if cond then x else error <xml>{txt msg} at {txt loc}</xml>
diff --git a/lib/ur/top.urs b/lib/ur/top.urs
index 15bc6a22..8273db0c 100644
--- a/lib/ur/top.urs
+++ b/lib/ur/top.urs
@@ -290,3 +290,10 @@ val postFields : postBody -> list (string * string)
 
 val max : t ::: Type -> ord t -> t -> t -> t
 val min : t ::: Type -> ord t -> t -> t -> t
+
+val assert : t ::: Type
+             -> bool   (* Did we avoid something bad? *)
+             -> string (* Explanation of the bad thing *)
+             -> string (* Source location of the bad thing *)
+             -> t      (* Return this value if all went well. *)
+             -> t
diff --git a/src/c/openssl.c b/src/c/openssl.c
index 1d820a34..6d018707 100644
--- a/src/c/openssl.c
+++ b/src/c/openssl.c
@@ -1,5 +1,6 @@
 #include "config.h"
 
+#include <assert.h>
 #include <stdlib.h>
 #include <unistd.h>
 #include <sys/types.h>
@@ -7,12 +8,17 @@
 #include <fcntl.h>
 #include <stdio.h>
 #include <string.h>
+#include <pthread.h>
 
+#include <openssl/crypto.h>
 #include <openssl/sha.h>
 #include <openssl/rand.h>
 
 #define PASSSIZE 4
 
+// OpenSSL locks array.  See threads(3SSL).
+static pthread_mutex_t *openssl_locks;
+
 int uw_hash_blocksize = 32;
 
 static int password[PASSSIZE];
@@ -27,7 +33,41 @@ static void random_password() {
   }
 }
 
+// OpenSSL callbacks
+static void thread_id(CRYPTO_THREADID *const result) {
+  CRYPTO_THREADID_set_numeric(result, pthread_self());
+}
+static void lock_or_unlock(const int mode, const int type, const char *file,
+                           const int line) {
+  pthread_mutex_t *const lock = &openssl_locks[type];
+  if (mode & CRYPTO_LOCK) {
+    if (pthread_mutex_lock(lock)) {
+      fprintf(stderr, "Can't take lock at %s:%d\n", file, line);
+      exit(1);
+    }
+  } else {
+    if (pthread_mutex_unlock(lock)) {
+      fprintf(stderr, "Can't release lock at %s:%d\n", file, line);
+      exit(1);
+    }
+  }
+}
+
 void uw_init_crypto() {
+  int i;
+  // Set up OpenSSL.
+  assert(openssl_locks == NULL);
+  openssl_locks = malloc(CRYPTO_num_locks() * sizeof(pthread_mutex_t));
+  if (!openssl_locks) {
+    perror("malloc");
+    exit(1);
+  }
+  for (i = 0; i < CRYPTO_num_locks(); ++i) {
+    pthread_mutex_init(&(openssl_locks[i]), NULL);
+  }
+  CRYPTO_THREADID_set_callback(thread_id);
+  CRYPTO_set_locking_callback(lock_or_unlock);
+  // Prepare signatures.
   if (uw_sig_file) {
     int fd;
 
diff --git a/src/c/static.c b/src/c/static.c
index c8fd5bc7..7f63d393 100644
--- a/src/c/static.c
+++ b/src/c/static.c
@@ -37,7 +37,7 @@ int main(int argc, char *argv[]) {
   while (1) {
     fk = uw_begin(ctx, argv[1]);
 
-    if (fk == SUCCESS) {
+    if (fk == SUCCESS || fk == RETURN_INDIRECTLY) {
       uw_print(ctx, 1);
       puts("");
       return 0;
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 1e49dae0..6d3836f1 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -167,13 +167,8 @@ void *uw_init_client_data();
 void uw_free_client_data(void *);
 void uw_copy_client_data(void *dst, void *src);
 
-static pthread_mutex_t rand_mutex = PTHREAD_MUTEX_INITIALIZER;
-
 static uw_Basis_int my_rand() {
-  pthread_mutex_lock(&rand_mutex);
   int ret, r = RAND_bytes((unsigned char *)&ret, sizeof ret);
-  pthread_mutex_unlock(&rand_mutex);
-
   if (r)
     return abs(ret);
   else
diff --git a/src/core_util.sml b/src/core_util.sml
index 152ba7ac..9ca85c37 100644
--- a/src/core_util.sml
+++ b/src/core_util.sml
@@ -203,7 +203,7 @@ fun compare ((c1, _), (c2, _)) =
       | (_, CConcat _) => GREATER
 
       | (CMap (d1, r1), CMap (d2, r2)) =>
-        join (Kind.compare (d1, r2),
+        join (Kind.compare (d1, d2),
               fn () => Kind.compare (r1, r2))
       | (CMap _, _) => LESS
       | (_, CMap _) => GREATER
@@ -607,15 +607,19 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, bind} =
               | ERel _ => S.return2 eAll
               | ENamed _ => S.return2 eAll
               | ECon (dk, pc, cs, NONE) =>
-                S.map2 (ListUtil.mapfold (mfc ctx) cs,
-                        fn cs' =>
-                           (ECon (dk, pc, cs', NONE), loc))
-              | ECon (dk, n, cs, SOME e) =>
-                S.bind2 (mfe ctx e,
-                      fn e' =>
+                S.bind2 (mfpc ctx pc,
+                      fn pc' =>
                          S.map2 (ListUtil.mapfold (mfc ctx) cs,
-                                 fn cs' =>
-                                    (ECon (dk, n, cs', SOME e'), loc)))
+                              fn cs' =>
+                                 (ECon (dk, pc', cs', NONE), loc)))
+              | ECon (dk, pc, cs, SOME e) =>
+                S.bind2 (mfpc ctx pc,
+                      fn pc' =>
+                         S.bind2 (mfe ctx e,
+                               fn e' =>
+                                  S.map2 (ListUtil.mapfold (mfc ctx) cs,
+                                       fn cs' =>
+                                          (ECon (dk, pc', cs', SOME e'), loc))))
               | EFfi _ => S.return2 eAll
               | EFfiApp (m, x, es) =>
                 S.map2 (ListUtil.mapfold (mfet ctx) es,
diff --git a/src/monoize.sml b/src/monoize.sml
index bac82f55..8934db2c 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2214,6 +2214,19 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             let
                 val t = monoType env t
                 val s = (L'.TFfi ("Basis", "string"), loc)
+
+                fun toSqlType (t : L'.typ) =
+                    case #1 t of
+                        L'.TFfi ("Basis", "int") => Settings.Int
+                      | L'.TFfi ("Basis", "float") => Settings.Float
+                      | L'.TFfi ("Basis", "string") => Settings.String
+                      | L'.TFfi ("Basis", "char") => Settings.Char
+                      | L'.TFfi ("Basis", "bool") => Settings.Bool
+                      | L'.TFfi ("Basis", "time") => Settings.Time
+                      | L'.TFfi ("Basis", "blob") => Settings.Blob
+                      | L'.TFfi ("Basis", "channel") => Settings.Channel
+                      | L'.TFfi ("Basis", "client") => Settings.Client
+                      | _ => raise Fail "Monoize/sql_option_prim: invalid SQL type"
             in
                 ((L'.EAbs ("f",
                            (L'.TFun (t, s), loc),
@@ -2223,7 +2236,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                      s,
                                      (L'.ECase ((L'.ERel 0, loc),
                                                 [((L'.PNone t, loc),
-                                                  str "NULL"),
+                                                  str (#p_cast (Settings.currentDbms ()) ("NULL", toSqlType t))),
                                                  ((L'.PSome (t, (L'.PVar ("y", t), loc)), loc),
                                                   (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc))],
                                                 {disc = (L'.TOption t, loc),
diff --git a/src/urweb.grm b/src/urweb.grm
index 7fc34793..50dacf21 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -1624,6 +1624,7 @@ xmlOne : NOTAGS                         (EApp ((EVar (["Basis"], "cdata", Infer)
                                                          val e = (EVar (["Basis"], "form", Infer), pos)
                                                          val e = (EApp (e, case #2 tag of
                                                                                NONE => (EVar (["Basis"], "None", Infer), pos)
+                                                                             | SOME (EPrim (Prim.String (_, s)), _) => (EApp ((EVar (["Basis"], "Some", Infer), pos), parseClass s pos), pos)
                                                                              | SOME c => (EApp ((EVar (["Basis"], "Some", Infer), pos), c), pos)), pos)
                                                      in
                                                          case #3 tag of
diff --git a/src/urweb.lex b/src/urweb.lex
index e1ffd1c3..f32ddf1e 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -178,11 +178,11 @@ fun unescape loc s =
 
 id = [a-z_][A-Za-z0-9_']*;
 xmlid = [A-Za-z][A-Za-z0-9_-]*;
-cid = [A-Z][A-Za-z0-9_]*;
+cid = [A-Z][A-Za-z0-9_']*;
 ws = [\ \t\012\r];
 intconst = [0-9]+;
 realconst = [0-9]+\.[0-9]*;
-hexconst = 0x[0-9A-F]{1,8};
+hexconst = 0x[0-9A-F]+;
 notags = ([^<{\n(]|(\([^\*<{\n]))+;
 xcom = ([^\-]|(-[^\-]))+;
 oint = [0-9][0-9][0-9];
@@ -537,22 +537,34 @@ xint = x[0-9a-fA-F][0-9a-fA-F];
 
 <INITIAL> "CURRENT_TIMESTAMP" => (Tokens.CURRENT_TIMESTAMP (pos yypos, pos yypos + size yytext));
 
-<INITIAL> "CURRENT_TIMESTAMP" => (Tokens.CURRENT_TIMESTAMP (pos yypos, pos yypos + size yytext));
+<INITIAL> "_LOC_" => (let val strLoc = ErrorMsg.spanToString (ErrorMsg.spanOf
+                                            (pos yypos, pos yypos + size yytext))
+                      in
+                          Tokens.STRING (strLoc, pos yypos, pos yypos + size yytext)
+                      end);
 
 <INITIAL> {id}        => (Tokens.SYMBOL (yytext, pos yypos, pos yypos + size yytext));
 <INITIAL> {cid}       => (Tokens.CSYMBOL (yytext, pos yypos, pos yypos + size yytext));
 
-<INITIAL> {hexconst}  => (case StringCvt.scanString (Int64.scan StringCvt.HEX) (String.extract (yytext, 2, NONE)) of
+<INITIAL> {hexconst}  => (let val digits = String.extract (yytext, 2, NONE)
+                              val v = (StringCvt.scanString (Int64.scan StringCvt.HEX) digits)
+                                      handle Overflow => NONE
+                          in
+                          case v of
                               SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext)
                             | NONE   => (ErrorMsg.errorAt' (pos yypos, pos yypos)
                                                            ("Expected hexInt, received: " ^ yytext);
-                                         continue ()));
+                                         continue ())
+                         end);
 
-<INITIAL> {intconst}  => (case Int64.fromString yytext of
+<INITIAL> {intconst}  => (let val v = (Int64.fromString yytext) handle Overflow => NONE
+                          in 
+                          case v of
                               SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext)
                             | NONE   => (ErrorMsg.errorAt' (pos yypos, pos yypos)
                                                            ("Expected int, received: " ^ yytext);
-                                         continue ()));
+                                         continue ())
+                         end);
 <INITIAL> {realconst} => (case Real64.fromString yytext of
                             SOME x => Tokens.FLOAT (x, pos yypos, pos yypos + size yytext)
                           | NONE   => (ErrorMsg.errorAt' (pos yypos, pos yypos)
diff --git a/tests/align.ur b/tests/align.ur
new file mode 100644
index 00000000..7d6664da
--- /dev/null
+++ b/tests/align.ur
@@ -0,0 +1,4 @@
+fun main () : transaction page = return <xml><body>
+  <p align="left">Left</p>
+  <p align="right">Right</p>
+</body></xml>
diff --git a/tests/bodyClick.ur b/tests/bodyClick.ur
new file mode 100644
index 00000000..9dcc64cf
--- /dev/null
+++ b/tests/bodyClick.ur
@@ -0,0 +1,6 @@
+fun main () : transaction page = return <xml>
+  <body onclick={fn _ => alert "You clicked the body."}
+        onkeyup={fn _ => alert "Key"}>
+    <p>Text</p>
+  </body>
+</xml>
diff --git a/tests/classy_form.ur b/tests/classy_form.ur
new file mode 100644
index 00000000..f9fafb6e
--- /dev/null
+++ b/tests/classy_form.ur
@@ -0,0 +1,9 @@
+style form_inline
+
+val main : transaction page = return <xml>
+  <body>
+    <form class="form-inline">
+      Problematic?
+    </form>
+  </body>
+</xml>
diff --git a/tests/crud1.html b/tests/crud1.html
new file mode 100644
index 00000000..7ed26d30
--- /dev/null
+++ b/tests/crud1.html
@@ -0,0 +1,38 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"><head></head><body>
+<p>Inserted with ID 1.</p>
+
+<table border="1">
+<tr>
+<th>ID</th>
+<th>A</th>
+<th>B</th>
+<th>C</th>
+<th>D</th>
+</tr>
+
+<tr>
+<td>1</td>
+<td>1</td>
+<td>2</td>
+<td>3</td>
+<td>True</td>
+<td>
+<a href="/Demo/Crud1/upd/1">[Update]</a>
+<a href="/Demo/Crud1/confirm/1">[Delete]</a>
+</td>
+</tr>
+
+</table>
+<br /><hr /><br />
+
+ <form method="post" action="/Demo/Crud1/create">
+<li> A: <input type="text" name="A" /></li>
+<li> B: <input type="text" name="B" /></li>
+<li> C: <input type="text" name="C" /></li>
+<li> D: <input type="checkbox" name="D" /></li>
+<input type="submit" />
+</form>
+
+</body></html>
+\ No newline at end of file
diff --git a/tests/hello.html b/tests/hello.html
new file mode 100644
index 00000000..9c249df0
--- /dev/null
+++ b/tests/hello.html
@@ -0,0 +1,10 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<title>Hello world!</title>
+</head>
+<body>
+<h1>Hello world!</h1>
+</body>
+</html>
+\ No newline at end of file
author	Benjamin Barenblat <bbaren@mit.edu>	2015-08-19 11:02:23 -0400
committer	Benjamin Barenblat <bbaren@mit.edu>	2015-08-19 11:02:23 -0400
commit	598756dc69f89cf2dd2b889cad63a7a690ae7ed7 (patch)
tree	5fc521225e717163c30ea494a5839c26725eec2e
parent	7ea9d17bad72cf2829c75d8d241fafa70b2c9b94 (diff)
parent	fb6e6599b35df9cfa05786772868b1a3d2e58ac3 (diff)