From 4df0acb85525a71e6f0b16c482b272cb4cc594ad Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 20 Jul 2017 11:01:27 -0400 Subject: Return to working version mode --- configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 5786c582..fc7bbe79 100644 --- a/configure.ac +++ b/configure.ac @@ -1,5 +1,5 @@ AC_INIT([urweb], [20170720]) -WORKING_VERSION=0 +WORKING_VERSION=1 AC_USE_SYSTEM_EXTENSIONS # automake 1.12 requires this, but automake 1.11 doesn't recognize it -- cgit v1.2.3 From 71950da171d0ae0da1ad3c06ab0e8a2070d9b23c Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 27 Jul 2017 15:30:42 -0400 Subject: Skip inappropriate postprocessing of text fields from multipart form data (fixes #82) --- src/cjr_print.sml | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 53587ff7..8fafc59f 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -2789,7 +2789,7 @@ fun p_file env (ds, ps) = string "}"] end - fun getInput (x, t) = + fun getInput includesFile (x, t) = let val n = case SM.find (fnums, x) of NONE => raise Fail ("CjrPrint: Can't find " ^ x ^ " in fnums") @@ -2839,7 +2839,7 @@ fun p_file env (ds, ps) = xts, newline, p_list_sep (box []) (fn (x, t) => - box [getInput (x, t), + box [getInput includesFile (x, t), string "result.__uwf_", string x, space, @@ -2902,7 +2902,7 @@ fun p_file env (ds, ps) = xts, newline, p_list_sep (box []) (fn (x, t) => - box [getInput (x, t), + box [getInput includesFile (x, t), string "result->__uwf_1.__uwf_", string x, space, @@ -2955,7 +2955,10 @@ fun p_file env (ds, ps) = space, string "=", space, - unurlify true env t, + if includesFile then + string "request" + else + unurlify true env t, string ";", newline] end @@ -2975,6 +2978,7 @@ fun p_file env (ds, ps) = (TRecord i, _) => let val xts = E.lookupStruct env i + val includesFile = List.exists (fn (_, t) => isFile t) xts in (List.take (ts, length ts - 2), box [box (map (fn (x, t) => box [p_typ env t, @@ -2984,7 +2988,7 @@ fun p_file env (ds, ps) = string ";", newline]) xts), newline, - box (map getInput xts), + box (map (getInput includesFile) xts), case i of 0 => string "uw_unit uw_inputs;" | _ => box [string "struct __uws_", -- cgit v1.2.3 From 34196bdad72334f9d8f809d6c9f564667f6011d4 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 27 Jul 2017 15:30:58 -0400 Subject: Add test cases for last commit --- tests/slashform.ur | 8 ++++++++ tests/slashform.urs | 1 + 2 files changed, 9 insertions(+) create mode 100644 tests/slashform.ur create mode 100644 tests/slashform.urs diff --git a/tests/slashform.ur b/tests/slashform.ur new file mode 100644 index 00000000..d5993a36 --- /dev/null +++ b/tests/slashform.ur @@ -0,0 +1,8 @@ +fun handler f = return {[f.F1]} {[f.F2]} + +val main = return
+ + + + +
 diff --git a/tests/slashform.urs b/tests/slashform.urs new file mode 100644 index 00000000..61778b87 --- /dev/null +++ b/tests/slashform.urs @@ -0,0 +1 @@ +val main : transaction page -- cgit v1.2.3 From 53dbce6998e78ddcb05693c7efdca101075941b0 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 27 Jul 2017 20:08:01 -0400 Subject: Fix last fix, to handle checkboxes properly --- src/cjr_print.sml | 7 ++++++- tests/slashform.ur | 3 ++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 8fafc59f..1fdb45d9 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -482,6 +482,11 @@ fun isFile (t : typ) = TFfi ("Basis", "file") => true | _ => false +fun isString (t : typ) = + case #1 t of + TFfi ("Basis", "string") => true + | _ => false + fun p_sql_type t = string (Settings.p_sql_ctype t) fun getPargs (e, _) = @@ -2955,7 +2960,7 @@ fun p_file env (ds, ps) = space, string "=", space, - if includesFile then + if includesFile andalso isString t then string "request" else unurlify true env t, diff --git a/tests/slashform.ur b/tests/slashform.ur index d5993a36..63591886 100644 --- a/tests/slashform.ur +++ b/tests/slashform.ur @@ -1,8 +1,9 @@ -fun handler f = return {[f.F1]} {[f.F2]} +fun handler f = return {[f.F1]} {[f.F2]} {[f.F3]} val main = return
+
-- cgit v1.2.3 From 5953eed7dc5c9f70940000c40c6ff5237a3b1808 Mon Sep 17 00:00:00 2001 From: Benjamin Barenblat Date: Tue, 2 May 2017 13:15:51 -0400 Subject: Enable -Wunused-parameter --- src/c/Makefile.am | 2 +- src/c/cgi.c | 21 +++++++++++++- src/c/fastcgi.c | 12 +++++++- src/c/http.c | 13 +++++++++ src/c/request.c | 4 +++ src/c/static.c | 12 ++++++++ src/c/urweb.c | 85 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 146 insertions(+), 3 deletions(-) diff --git a/src/c/Makefile.am b/src/c/Makefile.am index f4d9bef8..5c3a2b62 100644 --- a/src/c/Makefile.am +++ b/src/c/Makefile.am @@ -7,7 +7,7 @@ liburweb_fastcgi_la_SOURCES = fastcgi.c fastcgi.h liburweb_static_la_SOURCES = static.c AM_CPPFLAGS = -I$(srcdir)/../../include/urweb $(OPENSSL_INCLUDES) -AM_CFLAGS = -Wimplicit -Wall -Werror -Wno-format-security -Wno-deprecated-declarations -U_FORTIFY_SOURCE $(PTHREAD_CFLAGS) +AM_CFLAGS = -Wimplicit -Wall -Wunused-parameter -Werror -Wno-format-security -Wno-deprecated-declarations -U_FORTIFY_SOURCE $(PTHREAD_CFLAGS) liburweb_la_LDFLAGS = $(AM_LDFLAGS) $(OPENSSL_LDFLAGS) \ -export-symbols-regex '^(client_pruner|pthread_create_big|strcmp_nullsafe|uw_.*)' liburweb_la_LIBADD = $(PTHREAD_LIBS) -lm $(OPENSSL_LIBS) diff --git a/src/c/cgi.c b/src/c/cgi.c index d060532c..4d0f82b0 100644 --- a/src/c/cgi.c +++ b/src/c/cgi.c @@ -17,6 +17,8 @@ static char *uppercased; static size_t uppercased_len; static char *get_header(void *data, const char *h) { + (void)data; + size_t len = strlen(h); char *s, *r; const char *saved_h = h; @@ -41,16 +43,21 @@ static char *get_header(void *data, const char *h) { } static char *get_env(void *data, const char *name) { + (void)data; return getenv(name); } -static void on_success(uw_context ctx) { } +static void on_success(uw_context ctx) { + (void)ctx; +} static void on_failure(uw_context ctx) { uw_write_header(ctx, "Status: 500 Internal Server Error\r\n"); } static void log_error(void *data, const char *fmt, ...) { + (void)data; + va_list ap; va_start(ap, fmt); @@ -58,11 +65,16 @@ static void log_error(void *data, const char *fmt, ...) { } static void log_debug(void *data, const char *fmt, ...) { + (void)data; + (void)fmt; } static uw_loggers ls = {NULL, log_error, log_debug}; int main(int argc, char *argv[]) { + (void)argc; + (void)argv; + uw_context ctx = uw_request_new_context(0, &uw_application, &ls); uw_request_context rc = uw_new_request_context(); request_result rr; @@ -130,12 +142,17 @@ void *uw_init_client_data() { } void uw_free_client_data(void *data) { + (void)data; } void uw_copy_client_data(void *dst, void *src) { + (void)dst; + (void)src; } void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) { + (void)data; + uw_ensure_transaction(ctx); uw_get_app(ctx)->expunger(ctx, cli); @@ -144,6 +161,8 @@ void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) { } void uw_post_expunge(uw_context ctx, void *data) { + (void)ctx; + (void)data; } int uw_supports_direct_status = 0; diff --git a/src/c/fastcgi.c b/src/c/fastcgi.c index c37debf7..196b3d51 100644 --- a/src/c/fastcgi.c +++ b/src/c/fastcgi.c @@ -127,7 +127,9 @@ static FCGI_Record *fastcgi_recv(FCGI_Input *i) { } } -static void on_success(uw_context ctx) { } +static void on_success(uw_context ctx) { + (void)ctx; +} static void on_failure(uw_context ctx) { uw_write_header(ctx, "Status: 500 Internal Server Error\r\n"); @@ -554,6 +556,7 @@ static void help(char *cmd) { } static void sigint(int signum) { + (void)signum; printf("Exiting....\n"); exit(0); } @@ -674,12 +677,17 @@ void *uw_init_client_data() { } void uw_free_client_data(void *data) { + (void)data; } void uw_copy_client_data(void *dst, void *src) { + (void)dst; + (void)src; } void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) { + (void)data; + uw_ensure_transaction(ctx); uw_get_app(ctx)->expunger(ctx, cli); @@ -688,6 +696,8 @@ void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) { } void uw_post_expunge(uw_context ctx, void *data) { + (void)ctx; + (void)data; } int uw_supports_direct_status = 0; diff --git a/src/c/http.c b/src/c/http.c index 21ad809f..72685508 100644 --- a/src/c/http.c +++ b/src/c/http.c @@ -46,6 +46,7 @@ static char *get_header(void *data, const char *h) { } static char *get_env(void *data, const char *name) { + (void)data; return getenv(name); } @@ -58,6 +59,8 @@ static void on_failure(uw_context ctx) { } static void log_error(void *data, const char *fmt, ...) { + (void)data; + va_list ap; va_start(ap, fmt); @@ -65,6 +68,8 @@ static void log_error(void *data, const char *fmt, ...) { } static void log_debug(void *data, const char *fmt, ...) { + (void)data; + if (!quiet) { va_list ap; va_start(ap, fmt); @@ -332,6 +337,7 @@ static void help(char *cmd) { } static void sigint(int signum) { + (void)signum; printf("Exiting....\n"); exit(0); } @@ -542,12 +548,17 @@ void *uw_init_client_data() { } void uw_free_client_data(void *data) { + (void)data; } void uw_copy_client_data(void *dst, void *src) { + (void)dst; + (void)src; } void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) { + (void)data; + uw_ensure_transaction(ctx); uw_get_app(ctx)->expunger(ctx, cli); @@ -556,6 +567,8 @@ void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) { } void uw_post_expunge(uw_context ctx, void *data) { + (void)ctx; + (void)data; } int uw_supports_direct_status = 1; diff --git a/src/c/request.c b/src/c/request.c index a7f23851..3e7ac34c 100644 --- a/src/c/request.c +++ b/src/c/request.c @@ -78,6 +78,8 @@ uw_context uw_request_new_context(int id, uw_app *app, uw_loggers *ls) { } static void *ticker(void *data) { + (void)data; + while (1) { usleep(100000); ++uw_time; @@ -133,6 +135,8 @@ static unsigned long long stackSize; int pthread_create_big(pthread_t *outThread, void *foo, void *threadFunc, void *arg) { + (void)foo; + if (stackSize > 0) { int err; pthread_attr_t stackSizeAttribute; diff --git a/src/c/static.c b/src/c/static.c index d70881e2..76fe4129 100644 --- a/src/c/static.c +++ b/src/c/static.c @@ -8,6 +8,8 @@ extern uw_app uw_application; static void log_(void *data, const char *fmt, ...) { + (void)data; + va_list ap; va_start(ap, fmt); @@ -17,6 +19,8 @@ static void log_(void *data, const char *fmt, ...) { static uw_loggers loggers = {NULL, log_, log_}; static char *get_header(void *data, const char *h) { + (void)data; + (void)h; return NULL; } @@ -56,15 +60,23 @@ void *uw_init_client_data() { } void uw_free_client_data(void *data) { + (void)data; } void uw_copy_client_data(void *dst, void *src) { + (void)dst; + (void)src; } void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) { + (void)ctx; + (void)cli; + (void)data; } void uw_post_expunge(uw_context ctx, void *data) { + (void)ctx; + (void)data; } int uw_supports_direct_status = 0; diff --git a/src/c/urweb.c b/src/c/urweb.c index 6f2dde38..504597ef 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -1519,6 +1519,7 @@ uw_Basis_string uw_Basis_maybe_onunload(uw_context ctx, uw_Basis_string s) { } const char *uw_Basis_get_settings(uw_context ctx, uw_unit u) { + (void)u; if (ctx->client == NULL) { if (ctx->needs_sig) { char *sig = ctx->app->cookie_sig(ctx); @@ -1847,6 +1848,7 @@ char *uw_Basis_attrifyChar(uw_context ctx, uw_Basis_char c) { } char *uw_Basis_attrifyCss_class(uw_context ctx, uw_Basis_css_class s) { + (void)ctx; return s; } @@ -1973,6 +1975,7 @@ char *uw_Basis_urlifyString(uw_context ctx, uw_Basis_string s) { } char *uw_Basis_urlifyBool(uw_context ctx, uw_Basis_bool b) { + (void)ctx; if (b == uw_Basis_False) return "0"; else @@ -2093,6 +2096,8 @@ static char *uw_unurlify_advance(char *s) { } uw_Basis_int uw_Basis_unurlifyInt(uw_context ctx, char **s) { + (void)ctx; + char *new_s = uw_unurlify_advance(*s); uw_Basis_int r; @@ -2102,6 +2107,8 @@ uw_Basis_int uw_Basis_unurlifyInt(uw_context ctx, char **s) { } uw_Basis_float uw_Basis_unurlifyFloat(uw_context ctx, char **s) { + (void)ctx; + char *new_s = uw_unurlify_advance(*s); uw_Basis_float r; @@ -2165,6 +2172,8 @@ static uw_Basis_string uw_unurlifyString_to(int fromClient, uw_context ctx, char } uw_Basis_bool uw_Basis_unurlifyBool(uw_context ctx, char **s) { + (void)ctx; + char *new_s = uw_unurlify_advance(*s); uw_Basis_bool r; @@ -2192,6 +2201,7 @@ uw_Basis_string uw_Basis_unurlifyString(uw_context ctx, char **s) { } uw_Basis_unit uw_Basis_unurlifyUnit(uw_context ctx, char **s) { + (void)ctx; *s = uw_unurlify_advance(*s); return uw_unit_v; } @@ -2345,6 +2355,7 @@ uw_unit uw_Basis_htmlifyString_w(uw_context ctx, uw_Basis_string s) { } uw_Basis_string uw_Basis_htmlifyBool(uw_context ctx, uw_Basis_bool b) { + (void)ctx; if (b == uw_Basis_False) return "False"; else @@ -2428,10 +2439,13 @@ uw_Basis_string uw_Basis_strsuffix(uw_context ctx, uw_Basis_string s, uw_Basis_i } uw_Basis_int uw_Basis_strlen(uw_context ctx, uw_Basis_string s) { + (void)ctx; return strlen(s); } uw_Basis_bool uw_Basis_strlenGe(uw_context ctx, uw_Basis_string s, uw_Basis_int n) { + (void)ctx; + while (n > 0) { if (*s == 0) return uw_Basis_False; @@ -2444,10 +2458,12 @@ uw_Basis_bool uw_Basis_strlenGe(uw_context ctx, uw_Basis_string s, uw_Basis_int } uw_Basis_string uw_Basis_strchr(uw_context ctx, uw_Basis_string s, uw_Basis_char ch) { + (void)ctx; return strchr(s, ch); } uw_Basis_int uw_Basis_strcspn(uw_context ctx, uw_Basis_string s, uw_Basis_string chs) { + (void)ctx; return strcspn(s, chs); } @@ -2794,6 +2810,7 @@ uw_Basis_string uw_Basis_sqlifyStringN(uw_context ctx, uw_Basis_string s) { } char *uw_Basis_sqlifyBool(uw_context ctx, uw_Basis_bool b) { + (void)ctx; if (b == uw_Basis_False) return "FALSE"; else @@ -2914,6 +2931,7 @@ uw_Basis_string uw_Basis_charToString(uw_context ctx, uw_Basis_char ch) { } uw_Basis_string uw_Basis_boolToString(uw_context ctx, uw_Basis_bool b) { + (void)ctx; if (b == uw_Basis_False) return "False"; else @@ -2979,6 +2997,7 @@ uw_Basis_char *uw_Basis_stringToChar(uw_context ctx, uw_Basis_string s) { } uw_Basis_bool *uw_Basis_stringToBool(uw_context ctx, uw_Basis_string s) { + (void)ctx; static uw_Basis_bool true = uw_Basis_True; static uw_Basis_bool false = uw_Basis_False; @@ -3353,6 +3372,8 @@ static delta *allocate_delta(uw_context ctx, unsigned client) { } uw_Basis_channel uw_Basis_new_channel(uw_context ctx, uw_unit u) { + (void)u; + if (ctx->client == NULL) uw_error(ctx, FATAL, "Attempt to create channel on request not associated with a persistent connection"); @@ -3929,37 +3950,45 @@ int uw_streq(uw_Basis_string s1, uw_Basis_string s2) { } uw_Basis_string uw_Basis_sigString(uw_context ctx, uw_unit u) { + (void)u; ctx->usedSig = 1; return ctx->app->cookie_sig(ctx); } uw_Basis_string uw_Basis_fileName(uw_context ctx, uw_Basis_file f) { + (void)ctx; return f.name; } uw_Basis_string uw_Basis_fileMimeType(uw_context ctx, uw_Basis_file f) { + (void)ctx; return f.type; } uw_Basis_int uw_Basis_blobSize(uw_context ctx, uw_Basis_blob b) { + (void)ctx; return b.size; } uw_Basis_blob uw_Basis_textBlob(uw_context ctx, uw_Basis_string s) { + (void)ctx; uw_Basis_blob b = {strlen(s), s}; return b; } uw_Basis_blob uw_Basis_fileData(uw_context ctx, uw_Basis_file f) { + (void)ctx; return f.data; } uw_Basis_string uw_Basis_postType(uw_context ctx, uw_Basis_postBody pb) { + (void)ctx; return pb.type; } uw_Basis_string uw_Basis_postData(uw_context ctx, uw_Basis_postBody pb) { + (void)ctx; return pb.data; } @@ -4156,24 +4185,29 @@ uw_Basis_string uw_Basis_mstrcat(uw_context ctx, ...) { const uw_Basis_time uw_Basis_minTime = {}; uw_Basis_time uw_Basis_now(uw_context ctx) { + (void)ctx; uw_Basis_time r = { time(NULL) }; return r; } uw_Basis_time uw_Basis_addSeconds(uw_context ctx, uw_Basis_time tm, uw_Basis_int n) { + (void)ctx; tm.seconds += n; return tm; } uw_Basis_int uw_Basis_diffInSeconds(uw_context ctx, uw_Basis_time tm1, uw_Basis_time tm2) { + (void)ctx; return difftime(tm2.seconds, tm1.seconds); } uw_Basis_int uw_Basis_toMilliseconds(uw_context ctx, uw_Basis_time tm) { + (void)ctx; return tm.seconds * 1000 + tm.microseconds / 1000; } uw_Basis_time uw_Basis_fromMilliseconds(uw_context ctx, uw_Basis_int n) { + (void)ctx; uw_Basis_time tm = {n / 1000, n % 1000 * 1000}; return tm; } @@ -4183,10 +4217,12 @@ uw_Basis_int uw_Basis_diffInMilliseconds(uw_context ctx, uw_Basis_time tm1, uw_B } uw_Basis_int uw_Basis_toSeconds(uw_context ctx, uw_Basis_time tm) { + (void)ctx; return tm.seconds; } uw_Basis_time uw_Basis_fromDatetime(uw_context ctx, uw_Basis_int year, uw_Basis_int month, uw_Basis_int day, uw_Basis_int hour, uw_Basis_int minute, uw_Basis_int second) { + (void)ctx; struct tm tm = { .tm_year = year - 1900, .tm_mon = month, .tm_mday = day, .tm_hour = hour, .tm_min = minute, .tm_sec = second, .tm_isdst = -1 }; @@ -4195,42 +4231,49 @@ uw_Basis_time uw_Basis_fromDatetime(uw_context ctx, uw_Basis_int year, uw_Basis_ } uw_Basis_int uw_Basis_datetimeYear(uw_context ctx, uw_Basis_time time) { + (void)ctx; struct tm tm; localtime_r(&time.seconds, &tm); return tm.tm_year + 1900; } uw_Basis_int uw_Basis_datetimeMonth(uw_context ctx, uw_Basis_time time) { + (void)ctx; struct tm tm; localtime_r(&time.seconds, &tm); return tm.tm_mon; } uw_Basis_int uw_Basis_datetimeDay(uw_context ctx, uw_Basis_time time) { + (void)ctx; struct tm tm; localtime_r(&time.seconds, &tm); return tm.tm_mday; } uw_Basis_int uw_Basis_datetimeHour(uw_context ctx, uw_Basis_time time) { + (void)ctx; struct tm tm; localtime_r(&time.seconds, &tm); return tm.tm_hour; } uw_Basis_int uw_Basis_datetimeMinute(uw_context ctx, uw_Basis_time time) { + (void)ctx; struct tm tm; localtime_r(&time.seconds, &tm); return tm.tm_min; } uw_Basis_int uw_Basis_datetimeSecond(uw_context ctx, uw_Basis_time time) { + (void)ctx; struct tm tm; localtime_r(&time.seconds, &tm); return tm.tm_sec; } uw_Basis_int uw_Basis_datetimeDayOfWeek(uw_context ctx, uw_Basis_time time) { + (void)ctx; struct tm tm; localtime_r(&time.seconds, &tm); return tm.tm_wday; @@ -4272,66 +4315,82 @@ void uw_set_global(uw_context ctx, char *name, void *data, void (*free)(void*)) } uw_Basis_bool uw_Basis_isalnum(uw_context ctx, uw_Basis_char c) { + (void)ctx; return !!isalnum((int)c); } uw_Basis_bool uw_Basis_isalpha(uw_context ctx, uw_Basis_char c) { + (void)ctx; return !!isalpha((int)c); } uw_Basis_bool uw_Basis_isblank(uw_context ctx, uw_Basis_char c) { + (void)ctx; return !!isblank((int)c); } uw_Basis_bool uw_Basis_iscntrl(uw_context ctx, uw_Basis_char c) { + (void)ctx; return !!iscntrl((int)c); } uw_Basis_bool uw_Basis_isdigit(uw_context ctx, uw_Basis_char c) { + (void)ctx; return !!isdigit((int)c); } uw_Basis_bool uw_Basis_isgraph(uw_context ctx, uw_Basis_char c) { + (void)ctx; return !!isgraph((int)c); } uw_Basis_bool uw_Basis_islower(uw_context ctx, uw_Basis_char c) { + (void)ctx; return !!islower((int)c); } uw_Basis_bool uw_Basis_isprint(uw_context ctx, uw_Basis_char c) { + (void)ctx; return !!isprint((int)c); } uw_Basis_bool uw_Basis_ispunct(uw_context ctx, uw_Basis_char c) { + (void)ctx; return !!ispunct((int)c); } uw_Basis_bool uw_Basis_isspace(uw_context ctx, uw_Basis_char c) { + (void)ctx; return !!isspace((int)c); } uw_Basis_bool uw_Basis_isupper(uw_context ctx, uw_Basis_char c) { + (void)ctx; return !!isupper((int)c); } uw_Basis_bool uw_Basis_isxdigit(uw_context ctx, uw_Basis_char c) { + (void)ctx; return !!isxdigit((int)c); } uw_Basis_char uw_Basis_tolower(uw_context ctx, uw_Basis_char c) { + (void)ctx; return tolower((int)c); } uw_Basis_char uw_Basis_toupper(uw_context ctx, uw_Basis_char c) { + (void)ctx; return toupper((int)c); } uw_Basis_int uw_Basis_ord(uw_context ctx, uw_Basis_char c) { + (void)ctx; return (unsigned char)c; } uw_Basis_char uw_Basis_chr(uw_context ctx, uw_Basis_int n) { + (void)ctx; return n; } @@ -4437,10 +4496,12 @@ uw_Basis_string uw_Basis_crypt(uw_context ctx, uw_Basis_string key, uw_Basis_str } uw_Basis_bool uw_Basis_eq_time(uw_context ctx, uw_Basis_time t1, uw_Basis_time t2) { + (void)ctx; return !!(t1.seconds == t2.seconds && t1.microseconds == t2.microseconds); } uw_Basis_bool uw_Basis_lt_time(uw_context ctx, uw_Basis_time t1, uw_Basis_time t2) { + (void)ctx; return !!(t1.seconds < t2.seconds || (t1.seconds == t2.seconds && t1.microseconds < t2.microseconds)); } @@ -4505,66 +4566,82 @@ uw_Basis_string uw_Basis_fresh(uw_context ctx) { } uw_Basis_float uw_Basis_floatFromInt(uw_context ctx, uw_Basis_int n) { + (void)ctx; return n; } uw_Basis_int uw_Basis_ceil(uw_context ctx, uw_Basis_float n) { + (void)ctx; return ceil(n); } uw_Basis_int uw_Basis_trunc(uw_context ctx, uw_Basis_float n) { + (void)ctx; return trunc(n); } uw_Basis_int uw_Basis_round(uw_context ctx, uw_Basis_float n) { + (void)ctx; return round(n); } uw_Basis_int uw_Basis_floor(uw_context ctx, uw_Basis_float n) { + (void)ctx; return floor(n); } uw_Basis_float uw_Basis_pow(uw_context ctx, uw_Basis_float n, uw_Basis_float m) { + (void)ctx; return pow(n,m); } uw_Basis_float uw_Basis_sqrt(uw_context ctx, uw_Basis_float n) { + (void)ctx; return sqrt(n); } uw_Basis_float uw_Basis_sin(uw_context ctx, uw_Basis_float n) { + (void)ctx; return sin(n); } uw_Basis_float uw_Basis_cos(uw_context ctx, uw_Basis_float n) { + (void)ctx; return cos(n); } uw_Basis_float uw_Basis_log(uw_context ctx, uw_Basis_float n) { + (void)ctx; return log(n); } uw_Basis_float uw_Basis_exp(uw_context ctx, uw_Basis_float n) { + (void)ctx; return exp(n); } uw_Basis_float uw_Basis_asin(uw_context ctx, uw_Basis_float n) { + (void)ctx; return asin(n); } uw_Basis_float uw_Basis_acos(uw_context ctx, uw_Basis_float n) { + (void)ctx; return acos(n); } uw_Basis_float uw_Basis_atan(uw_context ctx, uw_Basis_float n) { + (void)ctx; return atan(n); } uw_Basis_float uw_Basis_atan2(uw_context ctx, uw_Basis_float n, uw_Basis_float m) { + (void)ctx; return atan2(n, m); } uw_Basis_float uw_Basis_abs(uw_context ctx, uw_Basis_float n) { + (void)ctx; return fabs(n); } @@ -4612,14 +4689,17 @@ uw_Basis_string uw_Basis_property(uw_context ctx, uw_Basis_string s) { } uw_Basis_string uw_Basis_fieldName(uw_context ctx, uw_Basis_postField f) { + (void)ctx; return f.name; } uw_Basis_string uw_Basis_fieldValue(uw_context ctx, uw_Basis_postField f) { + (void)ctx; return f.value; } uw_Basis_string uw_Basis_remainingFields(uw_context ctx, uw_Basis_postField f) { + (void)ctx; return f.remaining; } @@ -4754,6 +4834,7 @@ static char *uw_Sqlcache_keyCopy(char *buf, char *key) { // The NUL-terminated prefix of [key] below always looks something like "_k1_k2_k3..._kn". uw_Sqlcache_Value *uw_Sqlcache_check(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys) { + (void)ctx; int doBump = random() % 1024 == 0; if (doBump) { pthread_rwlock_wrlock(&cache->lockIn); @@ -4836,6 +4917,8 @@ static void uw_Sqlcache_storeCommitOne(uw_Sqlcache_Cache *cache, char **keys, uw } static void uw_Sqlcache_flushCommitOne(uw_Sqlcache_Cache *cache, char **keys) { + (void)cache; + (void)keys; } static void uw_Sqlcache_commit(void *data) { @@ -4854,6 +4937,7 @@ static void uw_Sqlcache_commit(void *data) { } static void uw_Sqlcache_free(void *data, int dontCare) { + (void)dontCare; uw_context ctx = (uw_context)data; uw_Sqlcache_Update *update = ctx->cacheUpdate; while (update) { @@ -4929,6 +5013,7 @@ void uw_Sqlcache_store(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys, uw } void uw_Sqlcache_flush(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys) { + (void)ctx; // A flush has to happen immediately so that subsequent stores in the same transaction fail. // This is safe to do because we will always call [uw_Sqlcache_wlock] earlier. // If the transaction fails, the only harm done is a few extra cache misses. -- cgit v1.2.3 From 2d61ba018a61cc89348a46df972e8dd4f1285ee7 Mon Sep 17 00:00:00 2001 From: Benjamin Barenblat Date: Tue, 2 May 2017 13:17:42 -0400 Subject: Remove redundant -Wimplicit -Wall implies -Wimplicit. --- src/c/Makefile.am | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/c/Makefile.am b/src/c/Makefile.am index 5c3a2b62..58f5153c 100644 --- a/src/c/Makefile.am +++ b/src/c/Makefile.am @@ -7,7 +7,7 @@ liburweb_fastcgi_la_SOURCES = fastcgi.c fastcgi.h liburweb_static_la_SOURCES = static.c AM_CPPFLAGS = -I$(srcdir)/../../include/urweb $(OPENSSL_INCLUDES) -AM_CFLAGS = -Wimplicit -Wall -Wunused-parameter -Werror -Wno-format-security -Wno-deprecated-declarations -U_FORTIFY_SOURCE $(PTHREAD_CFLAGS) +AM_CFLAGS = -Wall -Wunused-parameter -Werror -Wno-format-security -Wno-deprecated-declarations -U_FORTIFY_SOURCE $(PTHREAD_CFLAGS) liburweb_la_LDFLAGS = $(AM_LDFLAGS) $(OPENSSL_LDFLAGS) \ -export-symbols-regex '^(client_pruner|pthread_create_big|strcmp_nullsafe|uw_.*)' liburweb_la_LIBADD = $(PTHREAD_LIBS) -lm $(OPENSSL_LIBS) -- cgit v1.2.3 From 9fdb50d8ecc7782ae73472b9d943a24a304d0191 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Fri, 11 Aug 2017 19:38:33 -0400 Subject: Demo instructions: -noEmacs --- demo/prose | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/demo/prose b/demo/prose index 781eeed5..11b4a885 100644 --- a/demo/prose +++ b/demo/prose @@ -23,10 +23,10 @@ sudo make install
Compile the Demo the Easy Way
-

$ urweb -dbms sqlite -db /path_to_db.sqlite -demo /Demo demo
+
$ urweb -dbms sqlite -db /path_to_db.sqlite -demo /Demo -noEmacs demo

-

The -dbms sqlite flag indicates that instead of using the default database management system (PostgreSQL), we wish to use SQLite (usually unsuited for production). The -db flag allows us to specify the file-system path to our SQLite database. The -demo /Demo parameter indicates that we want to build a demo application that expects its URIs to begin with /Demo. The final argument demo gives the path to a directory housing Ur/Web source files (.ur, .urp, .urs, etc.). +

The -dbms sqlite flag indicates that instead of using the default database management system (PostgreSQL), we wish to use SQLite (usually unsuited for production). The -db flag allows us to specify the file-system path to our SQLite database. The -demo /Demo parameter indicates that we want to build a demo application that expects its URIs to begin with /Demo, while the -noEmacs parameter disables invocation of Emacs to syntax-highlight source files for HTML rendering. The final argument demo gives the path to a directory housing Ur/Web source files (.ur, .urp, .urs, etc.).

-- cgit v1.2.3 From 73fd5266bf7c1f05beb830c71107342c3a7be9c0 Mon Sep 17 00:00:00 2001 From: Peter Bock Date: Fri, 29 Sep 2017 06:26:25 +0200 Subject: new flag -help, and refactoring of flag parsing. --- src/main.mlton.sml | 343 ++++++++++++++++++++++++++++++----------------------- 1 file changed, 194 insertions(+), 149 deletions(-) diff --git a/src/main.mlton.sml b/src/main.mlton.sml index 2caa43f8..3d28acdc 100644 --- a/src/main.mlton.sml +++ b/src/main.mlton.sml @@ -27,15 +27,79 @@ val socket = ".urweb_daemon" -(* Encapsulate main invocation handler in a function, possibly to be called multiple times within a daemon. *) - exception Code of OS.Process.status +datatype flag_arity = + ZERO of (unit -> unit) + | ONE of string * (string -> unit) + | TWO of string * string * (string * string -> unit) + +fun parse_flags flag_info args = + let + fun search_pred flag0 = + (* Remove preceding "-". *) + let val flag0 = String.extract (flag0, 1, NONE) + in + fn (flag1, _, _) => flag0 = flag1 + end + + fun loop [] : string list = [] + | loop (arg :: args) = + if String.isPrefix "-" arg then + case List.find (search_pred arg) flag_info of + NONE => raise Fail ("Unknown flag "^arg^", see -help") + | SOME x => exec x args + else + arg :: loop args + + and exec (_, ZERO f, _) args = + (f (); loop args) + | exec (_, ONE (_, f), _) (x :: args) = + (f x; loop args) + | exec (_, TWO (_, _, f), _) (x :: y :: args) = + (f (x, y); loop args) + | exec (flag, ONE _, _) [] = + raise Fail ("Flag "^flag^" is missing an argument, see -help") + | exec (flag, TWO _, _) [] = + raise Fail ("Flag "^flag^" is missing two arguments, see -help") + | exec (flag, TWO _, _) [_] = + raise Fail ("Flag "^flag^" is missing an argument, see -help") + in + loop args + end + +fun usage flag_info = + let + val name = CommandLine.name () + + fun print_desc NONE = print "\n" + | print_desc (SOME s) = (print " : "; print s; print "\n") + + fun print_args (ZERO _) = () + | print_args (ONE (x, _)) = print (" " ^ x) + | print_args (TWO (x, y, _)) = print (" " ^ x ^ " " ^ y) + + fun print_flag (_, (flag, args, desc)) = + (print (" -" ^ flag); + print_args args; + print_desc desc) + in + print "usage: \n"; + print (" " ^ name ^ " daemon [stop|start]\n"); + print (" " ^ name ^ " [flag ...] project-name\n"); + print "Supported flags are:\n"; + ListUtil.appi print_flag flag_info; + raise Code OS.Process.success + end + + + +(* Encapsulate main invocation handler in a function, possibly to be called multiple times within a daemon. *) + fun oneRun args = let val timing = ref false val tc = ref false - val sources = ref ([] : string list) val demo = ref (NONE : (string * bool) option) val tutorial = ref false val css = ref false @@ -52,162 +116,143 @@ fun oneRun args = val () = Compiler.beforeC := MLton.GC.pack - fun printVersion () = (print (Config.versionString ^ "\n"); - raise Code OS.Process.success) - fun printNumericVersion () = (print (Config.versionNumber ^ "\n"); - raise Code OS.Process.success) - fun printCCompiler () = (print (Settings.getCCompiler () ^ "\n"); - raise Code OS.Process.success) - fun printCInclude () = (print (Config.includ ^ "\n"); - raise Code OS.Process.success) - - fun doArgs args = - case args of - [] => () - | "-version" :: rest => - printVersion () - | "-numeric-version" :: rest => - printNumericVersion () - | "-css" :: rest => - (css := true; - doArgs rest) - | "-print-ccompiler" :: rest => - printCCompiler () - | "-print-cinclude" :: rest => - printCInclude () - | "-ccompiler" :: ccomp :: rest => - (Settings.setCCompiler ccomp; - doArgs rest) - | "-demo" :: prefix :: rest => - (demo := SOME (prefix, false); - doArgs rest) - | "-guided-demo" :: prefix :: rest => - (demo := SOME (prefix, true); - doArgs rest) - | "-tutorial" :: rest => - (tutorial := true; - doArgs rest) - | "-protocol" :: name :: rest => - (Settings.setProtocol name; - doArgs rest) - | "-prefix" :: prefix :: rest => - (Settings.setUrlPrefix prefix; - doArgs rest) - | "-db" :: s :: rest => - (Settings.setDbstring (SOME s); - doArgs rest) - | "-dbms" :: name :: rest => - (Settings.setDbms name; - doArgs rest) - | "-debug" :: rest => - (Settings.setDebug true; - doArgs rest) - | "-verbose" :: rest => - (Compiler.debug := true; - Elaborate.verbose := true; - doArgs rest) - | "-timing" :: rest => - (timing := true; - doArgs rest) - | "-tc" :: rest => - (tc := true; - doArgs rest) - | "-dumpTypes" :: rest => - (Elaborate.dumpTypes := true; - doArgs rest) - | "-dumpTypesOnError" :: rest => - (Elaborate.dumpTypesOnError := true; - doArgs rest) - | "-unifyMore" :: rest => - (Elaborate.unifyMore := true; - doArgs rest) - | "-dumpSource" :: rest => - (Compiler.dumpSource := true; - doArgs rest) - | "-dumpVerboseSource" :: rest => - (Compiler.dumpSource := true; - ElabPrint.debug := true; - ExplPrint.debug := true; - CorePrint.debug := true; - MonoPrint.debug := true; - doArgs rest) - | "-output" :: s :: rest => - (Settings.setExe (SOME s); - doArgs rest) - | "-js" :: s :: rest => - (Settings.setOutputJsFile (SOME s); - doArgs rest) - | "-sql" :: s :: rest => - (Settings.setSql (SOME s); - doArgs rest) - | "-static" :: rest => - (Settings.setStaticLinking true; - doArgs rest) - | "-stop" :: phase :: rest => - (Compiler.setStop phase; - doArgs rest) - | "-path" :: name :: path :: rest => - (Compiler.addPath (name, path); - doArgs rest) - | "-root" :: name :: root :: rest => - (Compiler.addModuleRoot (root, name); - doArgs rest) - | "-boot" :: rest => - (Compiler.enableBoot (); - Settings.setBootLinking true; - doArgs rest) - | "-sigfile" :: name :: rest => - (Settings.setSigFile (SOME name); - doArgs rest) - | "-iflow" :: rest => - (Compiler.doIflow := true; - doArgs rest) - | "-sqlcache" :: rest => - (Settings.setSqlcache true; - doArgs rest) - | "-heuristic" :: h :: rest => - (Sqlcache.setHeuristic h; - doArgs rest) - | "-moduleOf" :: fname :: _ => - (print (Compiler.moduleOf fname ^ "\n"); - raise Code OS.Process.success) - | "-noEmacs" :: rest => - (Demo.noEmacs := true; - doArgs rest) - | "-limit" :: class :: num :: rest => - (case Int.fromString num of - NONE => raise Fail ("Invalid limit number '" ^ num ^ "'") - | SOME n => - if n < 0 then - raise Fail ("Invalid limit number '" ^ num ^ "'") - else - Settings.addLimit (class, n); - doArgs rest) - | "-explainEmbed" :: rest => - (JsComp.explainEmbed := true; - doArgs rest) - | arg :: rest => - (if size arg > 0 andalso String.sub (arg, 0) = #"-" then - raise Fail ("Unknown flag " ^ arg) + fun print_and_exit msg () = + (print msg; print "\n"; + raise Code OS.Process.success) + + val printVersion = print_and_exit Config.versionString + val printNumericVersion = print_and_exit Config.versionNumber + fun printCCompiler () = print_and_exit (Settings.getCCompiler ()) () + val printCInclude = print_and_exit Config.includ + + fun printModuleOf fname = + print_and_exit (Compiler.moduleOf fname) () + + fun add_class (class, num) = + case Int.fromString num of + NONE => raise Fail ("Invalid limit number '" ^ num ^ "'") + | SOME n => + if n < 0 then + raise Fail ("Invalid limit number '" ^ num ^ "'") else - sources := arg :: !sources; - doArgs rest) + Settings.addLimit (class, n) + + fun set_true flag = ZERO (fn () => flag := true) + fun call_true f = ZERO (fn () => f true) + + (* This is a function, and not simply a value, because it + * is recursive in the help-flag. *) + fun flag_info () = [ + ("help", ZERO (fn () => usage (flag_info ())), + SOME "print this overview"), + ("version", ZERO printVersion, + SOME "print version number and exit"), + ("numeric-version", ZERO printNumericVersion, + SOME "print numeric version number and exit"), + ("css", set_true css, + SOME "print categories of CSS properties"), + ("print-ccompiler", ZERO printCCompiler, + SOME "print C compiler and exit"), + ("print-cinclude", ZERO printCInclude, + SOME "print directory of C headers and exit"), + ("ccompiler", ONE ("", Settings.setCCompiler), + SOME "set the C compiler to "), + ("demo", ONE ("", fn prefix => + demo := SOME (prefix, false)), + NONE), + ("guided-demo", ONE ("", fn prefix => + demo := SOME (prefix, true)), + NONE), + ("tutorial", set_true tutorial, + NONE), + ("protocol", ONE ("[http|cgi|fastcgi|static]", + Settings.setProtocol), + SOME "set server protocol"), + ("prefix", ONE ("", Settings.setUrlPrefix), + SOME "set prefix used before all URI's"), + ("db", ONE ("", Settings.setDbstring o SOME), + SOME "database connection information"), + ("dbms", ONE ("[sqlite|mysql|postgrsql]", Settings.setDbms), + SOME "select database engine"), + ("debug", call_true Settings.setDebug, + NONE), + ("verbose", ZERO (fn () => + (Compiler.debug := true; + Elaborate.verbose := true)), + NONE), + ("timing", set_true timing, + SOME "time compilation phases"), + ("tc", set_true tc, + SOME "stop after type checking"), + ("dumpTypes", set_true Elaborate.dumpTypes, + SOME "print kinds and types"), + ("dumpTypesOnError", set_true Elaborate.dumpTypesOnError, + SOME "print kinds and types if there is an error"), + ("unifyMore", set_true Elaborate.unifyMore, + SOME "continue unification before reporting type error"), + ("dumpSource", set_true Compiler.dumpSource, + NONE), + ("dumpVerboseSource", ZERO (fn () => + (Compiler.dumpSource := true; + ElabPrint.debug := true; + ExplPrint.debug := true; + CorePrint.debug := true; + MonoPrint.debug := true)), + NONE), + ("output", ONE ("", Settings.setExe o SOME), + SOME "output executable as "), + ("js", ONE ("", Settings.setOutputJsFile o SOME), + SOME "serve javascript as "), + ("sql", ONE ("", Settings.setSql o SOME), + SOME "output sql script as "), + ("static", call_true Settings.setStaticLinking, + SOME "enable static linking"), + ("stop", ONE ("", Compiler.setStop), + SOME "stop compilation after "), + ("path", TWO ("", "", Compiler.addPath), + NONE), + ("root", TWO ("", "", + (fn (name, path) => + Compiler.addModuleRoot (path, name))), + NONE), + ("boot", ZERO (fn () => + (Compiler.enableBoot (); + Settings.setBootLinking true)), + NONE), + ("sigfile", ONE ("", Settings.setSigFile o SOME), + NONE), + ("iflow", set_true Compiler.doIflow, + NONE), + ("sqlcache", call_true Settings.setSqlcache, + NONE), + ("heuristic", ONE ("", Sqlcache.setHeuristic), + NONE), + ("moduleOf", ONE ("", printModuleOf), + SOME "print module name of and exit"), + ("noEmacs", set_true Demo.noEmacs, + NONE), + ("limit", TWO ("", "", add_class), + NONE), + ("explainEmbed", set_true JsComp.explainEmbed, + SOME ("explain errors about embedding of server-side "^ + "values in clinent code")) + ] val () = case args of ["daemon", "stop"] => OS.Process.exit OS.Process.success | _ => () - val () = doArgs args + val sources = parse_flags (flag_info ()) args val job = - case !sources of + case sources of [file] => file + | [] => + raise Fail "No project specified, see -help" | files => - if List.exists (fn s => s <> "-version") args then - raise Fail ("Zero or multiple input files specified; only one is allowed.\nFiles: " - ^ String.concatWith ", " files) - else - printVersion () + raise Fail ("Multiple projects specified;"^ + " only one is allowed.\nSpecified projects: "^ + String.concatWith ", " files) in case (!css, !demo, !tutorial) of (true, _, _) => -- cgit v1.2.3 From 06452188bc3a4f04762214ba7bcf7d4d0e36c9f3 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 1 Oct 2017 16:50:15 -0400 Subject: README extension: installation and simple invocation --- README.md | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) diff --git a/README.md b/README.md index 3bfd94a1..433ef0bb 100644 --- a/README.md +++ b/README.md @@ -19,3 +19,42 @@ Ur/Web is Ur plus a special standard library and associated rules for parsing an This type safety is just the foundation of the Ur/Web methodology. It is also possible to use metaprogramming to build significant application pieces by analysis of type structure. For instance, the demo includes an ML-style functor for building an admin interface for an arbitrary SQL table. The type system guarantees that the admin interface sub-application that comes out will always be free of the above-listed bugs, no matter which well-typed table description is given as input. The Ur/Web compiler also produces very efficient object code that does not use garbage collection. These compiled programs will often be even more efficient than what most programmers would bother to write in C. For example, the standalone web server generated for the demo uses less RAM than the bash shell. The compiler also generates JavaScript versions of client-side code, with no need to write those parts of applications in a different language. + +# Simple Invocation + +Here's a simple example of compiling, running, and accessing an application included with the Ur/Web distribution. + +```sh +urweb demo/hello +demo/hello.exe & +wget http://localhost:8080/Hello/main -O - +``` + +# Simple Installation + +The normal UNIX-style build and installation procedure works. + +```sh +./configure +make +sudo make install +``` + +However, some popular platforms have standard packages for Ur/Web, making installation and uninstallation even easier. + +## In Debian, Ubuntu, and Other Related Linux Distributions + +```sh +apt-get install urweb +``` + +## In Homebrew for Mac OS + +```sh +brew install urweb +``` + +# For More Detail + +See [the reference manual](http://www.impredicative.com/ur/manual.pdf). +Links to packages for other platforms also appear on [the project home page](http://www.impredicative.com/ur/). -- cgit v1.2.3 From b1a6440a3fb285cdfd5301510b96b1ef3b96c050 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 1 Oct 2017 17:13:17 -0400 Subject: New .urp directives: mimeTypes and long form of file --- doc/manual.tex | 2 ++ src/compiler.sig | 3 ++- src/compiler.sml | 31 ++++++++++++++++++++++--------- src/demo.sml | 3 ++- src/settings.sig | 5 ++++- src/settings.sml | 13 +++++++++---- tests/fake_types | 2 ++ tests/mimeTypesDirective.ur | 0 tests/mimeTypesDirective.urp | 6 ++++++ 9 files changed, 49 insertions(+), 16 deletions(-) create mode 100644 tests/fake_types create mode 100644 tests/mimeTypesDirective.ur create mode 100644 tests/mimeTypesDirective.urp diff --git a/doc/manual.tex b/doc/manual.tex index eaf7aab5..1b476499 100644 --- a/doc/manual.tex +++ b/doc/manual.tex @@ -150,6 +150,7 @@ Here is the complete list of directive forms. ``FFI'' stands for ``foreign func \item \texttt{effectful Module.ident} registers an FFI function or transaction as having side effects. The optimizer avoids removing, moving, or duplicating calls to such functions. This is the default behavior for \texttt{transaction}-based types. \item \texttt{exe FILENAME} sets the filename to which to write the output executable. The default for file \texttt{P.urp} is \texttt{P.exe}. \item \texttt{file URI FILENAME} asks for the application executable to respond to requests for \texttt{URI} by serving a snapshot of the contents of \texttt{FILENAME} as of compile time. That is, the file contents are baked into the executable. System file \texttt{/etc/mime.types} is consulted (again, at compile time) to figure out the right MIME type to suggest in the HTTP response. +\item \texttt{file URI FILENAME MIME-TYPE} works like the simpler form of \texttt{file}, but the proper MIME type for the file is given directly. \item \texttt{ffi FILENAME} reads the file \texttt{FILENAME.urs} to determine the interface to a new FFI module. The name of the module is calculated from \texttt{FILENAME} in the same way as for normal source files. See the files \texttt{include/urweb/urweb\_cpp.h} and \texttt{src/c/urweb.c} for examples of C headers and implementations for FFI modules. In general, every type or value \texttt{Module.ident} becomes \texttt{uw\_Module\_ident} in C. \item \texttt{html5} asks to generate HTML5 code, which primarily affects the first few lines of the output documents, like the \texttt{DOCTYPE}. This option is on by default. \item \texttt{include FILENAME} adds \texttt{FILENAME} to the list of files to be \texttt{\#include}d in C sources. This is most useful for interfacing with new FFI modules. @@ -176,6 +177,7 @@ Here is the complete list of directive forms. ``FFI'' stands for ``foreign func \end{itemize} \item \texttt{link FILENAME} adds \texttt{FILENAME} to the list of files to be passed to the linker at the end of compilation. This is most useful for importing extra libraries needed by new FFI modules. \item \texttt{linker CMD} sets \texttt{CMD} as the command line prefix to use for linking C object files. The command line will be completed with a space-separated list of \texttt{.o} and \texttt{.a} files, \texttt{-L} and \texttt{-l} flags, and finally with a \texttt{-o} flag to set the location where the executable should be written. +\item \texttt{mimeTypes PATH} sets the name of the file from which the MIME-type database is read, as a substitute for the usual \texttt{/etc/mime.types} on UNIX systems. \item \texttt{minHeap NUMBYTES} sets the initial size for thread-local heaps used in handling requests. These heaps grow automatically as needed (up to any maximum set with \texttt{limit}), but each regrow requires restarting the request handling process. \item \texttt{monoInline TREESIZE} sets how many nodes the AST of a function definition may have before the optimizer stops trying hard to inline calls to that function. (This is one of two options for one of two intermediate languages within the compiler.) \item \texttt{neverInline PATH} requests that no call to the referenced function be inlined. Section \ref{structure} explains how functions are assigned path strings. diff --git a/src/compiler.sig b/src/compiler.sig index 952c7070..0ff84f1c 100644 --- a/src/compiler.sig +++ b/src/compiler.sig @@ -62,7 +62,8 @@ signature COMPILER = sig sigFile : string option, safeGets : string list, onError : (string * string list * string) option, - minHeap : int + minHeap : int, + mimeTypes : string option } val compile : string -> bool val compiler : string -> unit diff --git a/src/compiler.sml b/src/compiler.sml index c13de304..3fb0b767 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -66,7 +66,8 @@ type job = { sigFile : string option, safeGets : string list, onError : (string * string list * string) option, - minHeap : int + minHeap : int, + mimeTypes : string option } type ('src, 'dst) phase = { @@ -386,7 +387,8 @@ fun institutionalizeJob (job : job) = Settings.setSafeGets (#safeGets job); Settings.setOnError (#onError job); Settings.setMinHeap (#minHeap job); - Settings.setSigFile (#sigFile job)) + Settings.setSigFile (#sigFile job); + Settings.setMimeFilePath (Option.getOpt (#mimeTypes job, "/etc/mime.types"))) datatype commentableLine = EndOfFile @@ -467,7 +469,8 @@ fun parseUrp' accLibs fname = sigFile = NONE, safeGets = [], onError = NONE, - minHeap = 0} + minHeap = 0, + mimeTypes = NONE} in institutionalizeJob job; {Job = job, Libs = []} @@ -601,6 +604,7 @@ fun parseUrp' accLibs fname = val safeGets = ref [] val onError = ref NONE val minHeap = ref 0 + val mimeTypes = ref NONE fun finish sources = let @@ -638,7 +642,8 @@ fun parseUrp' accLibs fname = sigFile = !sigFile, safeGets = rev (!safeGets), onError = !onError, - minHeap = !minHeap + minHeap = !minHeap, + mimeTypes = !mimeTypes } fun mergeO f (old, new) = @@ -699,7 +704,8 @@ fun parseUrp' accLibs fname = sigFile = mergeO #2 (#sigFile old, #sigFile new), safeGets = #safeGets old @ #safeGets new, onError = mergeO #2 (#onError old, #onError new), - minHeap = Int.max (#minHeap old, #minHeap new) + minHeap = Int.max (#minHeap old, #minHeap new), + mimeTypes = mergeO #2 (#mimeTypes old, #mimeTypes new) } in if accLibs then @@ -914,13 +920,20 @@ fun parseUrp' accLibs fname = | "html5" => Settings.setIsHtml5 true | "xhtml" => Settings.setIsHtml5 false | "lessSafeFfi" => Settings.setLessSafeFfi true + | "mimeTypes" => Settings.setMimeFilePath (relify arg) | "file" => (case String.fields Char.isSpace arg of - [uri, fname] => (Settings.setFilePath thisPath; - Settings.addFile {Uri = uri, - LoadFromFilename = fname}; - url := {action = Settings.Allow, kind = Settings.Exact, pattern = uri} :: !url) + uri :: fname :: rest => + (Settings.setFilePath thisPath; + Settings.addFile {Uri = uri, + LoadFromFilename = fname, + MimeType = case rest of + [] => NONE + | [ty] => SOME ty + | _ => (ErrorMsg.error "Bad 'file' arguments"; + NONE)}; + url := {action = Settings.Allow, kind = Settings.Exact, pattern = uri} :: !url) | _ => ErrorMsg.error "Bad 'file' arguments") | "jsFile" => diff --git a/src/demo.sml b/src/demo.sml index 62b9037a..a682d28d 100644 --- a/src/demo.sml +++ b/src/demo.sml @@ -125,7 +125,8 @@ fun make' {prefix, dirname, guided} = sigFile = mergeWith #2 (#sigFile combined, #sigFile urp), safeGets = #safeGets combined @ #safeGets urp, onError = NONE, - minHeap = 0 + minHeap = 0, + mimeTypes = mergeWith #2 (#mimeTypes combined, #mimeTypes urp) } val parse = Compiler.run (Compiler.transform Compiler.parseUrp "Demo parseUrp") diff --git a/src/settings.sig b/src/settings.sig index 256a12b5..729218ac 100644 --- a/src/settings.sig +++ b/src/settings.sig @@ -298,7 +298,7 @@ signature SETTINGS = sig val setFilePath : string -> unit (* Sets the directory where we look for files being added below. *) - val addFile : {Uri : string, LoadFromFilename : string} -> unit + val addFile : {Uri : string, LoadFromFilename : string, MimeType : string option} -> unit val listFiles : unit -> {Uri : string, ContentType : string option, LastModified : Time.time, Bytes : Word8Vector.vector} list val addJsFile : string (* filename *) -> unit @@ -306,4 +306,7 @@ signature SETTINGS = sig val setOutputJsFile : string option (* filename *) -> unit val getOutputJsFile : unit -> string option + + val setMimeFilePath : string -> unit + (* Set unusual location for /etc/mime.types. *) end diff --git a/src/settings.sml b/src/settings.sml index a3263c06..d3ac99d4 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -843,14 +843,17 @@ structure SM = BinaryMapFn(struct val noMimeFile = ref false +val mimeFilePath = ref "/etc/mime.types" +fun setMimeFilePath file = mimeFilePath := file + fun noMime () = - (TextIO.output (TextIO.stdErr, "WARNING: Error opening /etc/mime.types. Static files will be served with no suggested MIME types.\n"); + (TextIO.output (TextIO.stdErr, "WARNING: Error opening " ^ !mimeFilePath ^ ". Static files will be served with no suggested MIME types.\n"); noMimeFile := true; SM.empty) fun readMimeTypes () = let - val inf = FileIO.txtOpenIn "/etc/mime.types" + val inf = FileIO.txtOpenIn (!mimeFilePath) fun loop m = case TextIO.inputLine inf of @@ -908,7 +911,7 @@ val filePath = ref "." fun setFilePath path = filePath := path -fun addFile {Uri, LoadFromFilename} = +fun addFile {Uri, LoadFromFilename, MimeType} = let val path = OS.Path.concat (!filePath, LoadFromFilename) in @@ -926,7 +929,9 @@ fun addFile {Uri, LoadFromFilename} = Uri, (path, {Uri = Uri, - ContentType = mimeTypeOf path, + ContentType = case MimeType of + NONE => mimeTypeOf path + | _ => MimeType, LastModified = OS.FileSys.modTime path, Bytes = BinIO.inputAll inf})); BinIO.closeIn inf diff --git a/tests/fake_types b/tests/fake_types new file mode 100644 index 00000000..405e9d1d --- /dev/null +++ b/tests/fake_types @@ -0,0 +1,2 @@ +horrible_idea/blorpapalooza txt +whoa/yowza html diff --git a/tests/mimeTypesDirective.ur b/tests/mimeTypesDirective.ur new file mode 100644 index 00000000..e69de29b diff --git a/tests/mimeTypesDirective.urp b/tests/mimeTypesDirective.urp new file mode 100644 index 00000000..43f06a00 --- /dev/null +++ b/tests/mimeTypesDirective.urp @@ -0,0 +1,6 @@ +mimeTypes fake_types +file /hello.txt hello.txt +file /hello.html hello.html +file /hello2.txt hello.txt gadzooks/yippie + +mimeTypesDirective -- cgit v1.2.3 From 2d22156b3814802c7f1c46db5f553af6904a794d Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 1 Oct 2017 17:32:07 -0400 Subject: Small tweaks to new help text --- src/main.mlton.sml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/main.mlton.sml b/src/main.mlton.sml index 3d28acdc..1229d552 100644 --- a/src/main.mlton.sml +++ b/src/main.mlton.sml @@ -79,7 +79,7 @@ fun usage flag_info = | print_args (ONE (x, _)) = print (" " ^ x) | print_args (TWO (x, y, _)) = print (" " ^ x ^ " " ^ y) - fun print_flag (_, (flag, args, desc)) = + fun print_flag (flag, args, desc) = (print (" -" ^ flag); print_args args; print_desc desc) @@ -88,7 +88,7 @@ fun usage flag_info = print (" " ^ name ^ " daemon [stop|start]\n"); print (" " ^ name ^ " [flag ...] project-name\n"); print "Supported flags are:\n"; - ListUtil.appi print_flag flag_info; + app print_flag flag_info; raise Code OS.Process.success end @@ -172,7 +172,7 @@ fun oneRun args = SOME "set prefix used before all URI's"), ("db", ONE ("", Settings.setDbstring o SOME), SOME "database connection information"), - ("dbms", ONE ("[sqlite|mysql|postgrsql]", Settings.setDbms), + ("dbms", ONE ("[sqlite|mysql|postgres]", Settings.setDbms), SOME "select database engine"), ("debug", call_true Settings.setDebug, NONE), @@ -202,7 +202,7 @@ fun oneRun args = ("output", ONE ("", Settings.setExe o SOME), SOME "output executable as "), ("js", ONE ("", Settings.setOutputJsFile o SOME), - SOME "serve javascript as "), + SOME "serve JavaScript as "), ("sql", ONE ("", Settings.setSql o SOME), SOME "output sql script as "), ("static", call_true Settings.setStaticLinking, @@ -235,7 +235,7 @@ fun oneRun args = NONE), ("explainEmbed", set_true JsComp.explainEmbed, SOME ("explain errors about embedding of server-side "^ - "values in clinent code")) + "values in client code")) ] val () = case args of -- cgit v1.2.3 From fb4e582bd0a673fc792d0fcc49fdcac2097bb0e0 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 11 Nov 2017 16:01:34 -0500 Subject: Manual fix: [self] only callable on the server --- doc/manual.tex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/manual.tex b/doc/manual.tex index 1b476499..985dab5b 100644 --- a/doc/manual.tex +++ b/doc/manual.tex @@ -2237,7 +2237,7 @@ $$\begin{array}{l} \subsubsection{Asynchronous Message-Passing} -To support asynchronous, ``server push'' delivery of messages to clients, any client that might need to receive an asynchronous message is assigned a unique ID. These IDs may be retrieved both on the client and on the server, during execution of code related to a client. +To support asynchronous, ``server push'' delivery of messages to clients, any client that might need to receive an asynchronous message is assigned a unique ID. These IDs may be retrieved only on the server, during execution of code related to a client. $$\begin{array}{l} \mt{type} \; \mt{client} \\ -- cgit v1.2.3 From 8604afcbc37276760ae74b2d1fbe200aa4b64dce Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 18 Nov 2017 15:42:31 -0500 Subject: README: mention that GNU Make is required --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 433ef0bb..911d13f0 100644 --- a/README.md +++ b/README.md @@ -32,7 +32,7 @@ wget http://localhost:8080/Hello/main -O - # Simple Installation -The normal UNIX-style build and installation procedure works. +The normal UNIX-style build and installation procedure works (where the `make` program needs to be GNU Make). ```sh ./configure -- cgit v1.2.3 From a707c42ce3773318f80ed78eea653a581639fdba Mon Sep 17 00:00:00 2001 From: Vladimir Shabanov Date: Tue, 5 Dec 2017 17:24:12 +0300 Subject: Added oninput event to inputs which support it. Added onscroll event to and title/sizes attributes to . --- lib/js/urweb.js | 8 +++++ lib/ur/basis.urs | 94 +++++++++++++++++++++++++++----------------------------- src/monoize.sml | 4 +++ 3 files changed, 57 insertions(+), 49 deletions(-) diff --git a/lib/js/urweb.js b/lib/js/urweb.js index ebe192ca..1a275451 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -1389,6 +1389,14 @@ function addOnChange(x, f) { x.onchange = function() { old(); f(); }; } +function addOnInput(x, f) { + var old = x.oninput; + if (old == null) + x.oninput = f; + else + x.oninput = function() { old(); f(); }; +} + function addOnKeyUp(x, f) { var old = x.onkeyup; if (old == null) diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 89a48d59..c354d784 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -830,7 +830,7 @@ val data_attrs : data_attr -> data_attr -> data_attr 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, Integrity = string, Crossorigin = string] head [] [] [] +val link : unit -> tag [Data = data_attr, Id = id, Rel = string, Title = string, Typ = string, Href = url, Media = string, Integrity = string, Crossorigin = string, Sizes = string] head [] [] [] val meta : unit -> tag [Nam = meta, Content = string, Id = id] head [] [] [] datatype mouseButton = Left | Right | Middle @@ -842,14 +842,26 @@ type mouseEvent = { ScreenX : int, ScreenY : int, ClientX : int, ClientY : int, con mouseEvents = map (fn _ :: Unit => mouseEvent -> transaction unit) [Onclick, Oncontextmenu, Ondblclick, Onmousedown, Onmouseenter, Onmouseleave, Onmousemove, Onmouseout, Onmouseover, Onmouseup] +(* Key arguments are character codes. *) type keyEvent = { KeyCode : int, CtrlKey : bool, ShiftKey : bool, AltKey : bool, MetaKey : bool } 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) +con focusEvents = [Onblur = transaction unit, Onfocus = transaction unit] + +con resizeEvents = [Onresize = transaction unit] +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, Align = string] ++ boxEvents +con tableAttrs = [Data = data_attr, Id = id, Title = string, Align = string] ++ tableEvents + +val body : unit -> tag ([Data = data_attr, Id = id, Title = string, Onload = transaction unit, Onunload = transaction unit, Onhashchange = transaction unit] + ++ boxEvents) html body [] [] con bodyTag = fn (attrs :: {Type}) => @@ -863,19 +875,6 @@ con bodyTagStandalone = fn (attrs :: {Type}) => 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] - -con boxEvents = focusEvents ++ mouseEvents ++ keyEvents ++ resizeEvents ++ scrollEvents -con tableEvents = focusEvents ++ mouseEvents ++ keyEvents - -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 @@ -975,21 +974,20 @@ con formTag = fn (ty :: Type) (inner :: {Unit}) (attrs :: {Type}) => nm :: Name -> unit -> tag attrs ([Form] ++ ctx) inner [] [nm = ty] -con inputAttrs = [Required = bool, Autofocus = bool] - +con inputAttrs' = [Required = bool, Autofocus = bool, + Onchange = transaction unit] +con inputAttrs = inputAttrs' ++ [Oninput = transaction unit] val hidden : formTag string [] [Data = data_attr, Id = string, Value = string] -val textbox : formTag string [] ([Value = string, Size = int, Placeholder = string, Source = source string, Onchange = transaction unit, - Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) -val password : formTag string [] ([Value = string, Size = int, Placeholder = string, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) -val textarea : formTag string [] ([Rows = int, Cols = int, Placeholder = string, Onchange = transaction unit, - Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) +val textbox : formTag string [] ([Value = string, Size = int, Placeholder = string, Source = source string] ++ boxAttrs ++ inputAttrs) +val password : formTag string [] ([Value = string, Size = int, Placeholder = string] ++ boxAttrs ++ inputAttrs) +val textarea : formTag string [] ([Rows = int, Cols = int, Placeholder = string] ++ boxAttrs ++ inputAttrs) -val checkbox : formTag bool [] ([Checked = bool, Onchange = transaction unit] ++ boxAttrs) +val checkbox : formTag bool [] ([Checked = bool] ++ boxAttrs ++ inputAttrs') (* HTML5 widgets galore! *) -type textWidget = formTag string [] ([Value = string, Size = int, Placeholder = string, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) +type textWidget = formTag string [] ([Value = string, Size = int, Placeholder = string] ++ boxAttrs ++ inputAttrs) val email : textWidget val search : textWidget @@ -997,14 +995,14 @@ val url_ : textWidget val tel : textWidget val color : textWidget -val number : formTag float [] ([Value = float, Min = float, Max = float, Step = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) -val range : formTag float [] ([Value = float, Min = float, Max = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) -val date : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) -val datetime : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) -val datetime_local : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) -val month : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) -val week : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) -val timeInput : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) +val number : formTag float [] ([Value = float, Min = float, Max = float, Step = float, Size = int] ++ boxAttrs ++ inputAttrs) +val range : formTag float [] ([Value = float, Min = float, Max = float, Size = int] ++ boxAttrs ++ inputAttrs) +val date : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) +val datetime : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) +val datetime_local : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) +val month : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) +val week : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) +val timeInput : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) @@ -1034,10 +1032,10 @@ 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, Onchange = transaction unit] ++ boxAttrs) radio [] [] [] +val radioOption : unit -> tag ([Value = string, Checked = bool] ++ boxAttrs ++ inputAttrs') radio [] [] [] con select = [Select] -val select : formTag string select ([Onchange = transaction unit] ++ boxAttrs) +val select : formTag string select (boxAttrs ++ inputAttrs') val option : unit -> tag [Data = data_attr, Value = string, Selected = bool] select [] [] [] val submit : ctx ::: {Unit} -> use ::: {Type} @@ -1065,8 +1063,7 @@ con cformTag = fn (attrs :: {Type}) (inner :: {Unit}) => -> [[Body] ~ ctx] => [[Body] ~ inner] => unit -> tag attrs ([Body] ++ ctx) ([Body] ++ inner) [] [] -type ctext = cformTag ([Value = string, Size = int, Source = source string, Placeholder = string, - Onchange = transaction unit, Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) [] +type ctext = cformTag ([Value = string, Size = int, Source = source string, Placeholder = string] ++ boxAttrs ++ inputAttrs) [] val ctextbox : ctext val cpassword : ctext @@ -1076,24 +1073,23 @@ val curl : ctext val ctel : ctext val ccolor : ctext -val cnumber : cformTag ([Source = source (option float), Min = float, Max = float, Step = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] -val crange : cformTag ([Source = source (option float), Min = float, Max = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] -val cdate : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] -val cdatetime : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] -val cdatetime_local : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] -val cmonth : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] -val cweek : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] -val ctime : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] +val cnumber : cformTag ([Source = source (option float), Min = float, Max = float, Step = float, Size = int] ++ boxAttrs ++ inputAttrs) [] +val crange : cformTag ([Source = source (option float), Min = float, Max = float, Size = int] ++ boxAttrs ++ inputAttrs) [] +val cdate : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) [] +val cdatetime : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) [] +val cdatetime_local : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) [] +val cmonth : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) [] +val cweek : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) [] +val ctime : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) [] val button : cformTag ([Value = string, Disabled = bool] ++ boxAttrs) [] -val ccheckbox : cformTag ([Size = int, Source = source bool, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] +val ccheckbox : cformTag ([Size = int, Source = source bool] ++ boxAttrs ++ inputAttrs') [] -val cselect : cformTag ([Source = source string, Onchange = transaction unit] ++ boxAttrs) [Cselect] +val cselect : cformTag ([Source = source string] ++ boxAttrs ++ inputAttrs') [Cselect] val coption : unit -> tag [Value = string, Selected = bool] [Cselect, Body] [] [] [] -val ctextarea : cformTag ([Rows = int, Cols = int, Placeholder = string, Source = source string, Onchange = transaction unit, - Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) [] +val ctextarea : cformTag ([Rows = int, Cols = int, Placeholder = string, Source = source string] ++ boxAttrs ++ inputAttrs) [] (*** Tables *) diff --git a/src/monoize.sml b/src/monoize.sml index ddf6cd4c..60ff78ea 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -3281,6 +3281,10 @@ fun monoExp (env, st, fm) (all as (e, loc)) = SOME (strcat [str "addOnChange(d,exec(", (L'.EJavaScript (L'.Script, e), loc), str "));"]) + | ("Oninput", e, _) => + SOME (strcat [str "addOnInput(d,exec(", + (L'.EJavaScript (L'.Script, e), loc), + str "));"]) | (x, e, (L'.TFun ((L'.TRecord [], _), _), _)) => SOME (strcat [str ("d." ^ lowercaseFirst x ^ "=exec("), (L'.EJavaScript (L'.Script, e), loc), -- cgit v1.2.3 From 5d6b1ac92263d41c32e896603b4fa3e1790c9d71 Mon Sep 17 00:00:00 2001 From: Vladimir Shabanov Date: Wed, 13 Dec 2017 19:24:56 +0300 Subject: dynClass() now calculates and sets class and style attributes before adding node to DOM. --- lib/js/urweb.js | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/lib/js/urweb.js b/lib/js/urweb.js index 1a275451..d8198ed0 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -1286,11 +1286,12 @@ function dynClass(pnode, html, s_class, s_style) { if (pnode == "table" && html.tagName == "TBODY") { html = html.firstChild; } - addNode(html); - runScripts(html); + + var x = null; + var y = null; if (s_class) { - var x = document.createElement("script"); + x = document.createElement("script"); x.dead = false; x.signal = s_class; x.sources = null; @@ -1305,13 +1306,12 @@ function dynClass(pnode, html, s_class, s_style) { x.closures = concat(cls.v, htmlCls); } - html.appendChild(x); populate(x); } if (s_style) { var htmlCls2 = s_class ? null : htmlCls; - var y = document.createElement("script"); + y = document.createElement("script"); y.dead = false; y.signal = s_style; y.sources = null; @@ -1326,9 +1326,16 @@ function dynClass(pnode, html, s_class, s_style) { y.closures = concat(cls.v, htmlCls2); } - html.appendChild(y); populate(y); } + + addNode(html); + runScripts(html); + + if (x) + html.appendChild(x); + if (y) + html.appendChild(y); } function bodyDynClass(s_class, s_style) { -- cgit v1.2.3 From 1c9b94a22036cec4e3d0430ca2991eefc8198350 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 6 Jan 2018 10:40:15 -0500 Subject: README: explain need to run autogen.sh (closes #93) --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 911d13f0..5863d242 100644 --- a/README.md +++ b/README.md @@ -32,7 +32,7 @@ wget http://localhost:8080/Hello/main -O - # Simple Installation -The normal UNIX-style build and installation procedure works (where the `make` program needs to be GNU Make). +The normal UNIX-style build and installation procedure works (where the `make` program needs to be GNU Make, and where `./autogen.sh` must be run first only if starting from a Git checkout rather than a release tarball). ```sh ./configure -- cgit v1.2.3 From 458c671a9d5fb352aafebe4b9e1b00670e8e706f Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Mon, 8 Jan 2018 14:26:00 -0500 Subject: Proper handling of absolute paths for files to serve --- src/settings.sml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/settings.sml b/src/settings.sml index d3ac99d4..9e6d3e76 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -914,6 +914,7 @@ fun setFilePath path = filePath := path fun addFile {Uri, LoadFromFilename, MimeType} = let val path = OS.Path.concat (!filePath, LoadFromFilename) + handle Path => LoadFromFilename in case SM.find (!files, Uri) of SOME (path', _) => -- cgit v1.2.3 From e6567eca7c5567b8bd4a93ba516170aed9e30662 Mon Sep 17 00:00:00 2001 From: steinuil Date: Mon, 26 Feb 2018 15:54:56 +0100 Subject: automatically enable foreign keys and WAL for SQLite --- src/sqlite.sml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/sqlite.sml b/src/sqlite.sml index a9b6389d..0acd866b 100644 --- a/src/sqlite.sml +++ b/src/sqlite.sml @@ -273,6 +273,11 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = string "\"Can't open SQLite database.\");", newline, newline, + string "if (sqlite3_exec(sqlite, \"PRAGMA foreign_keys = ON\", NULL, NULL, NULL) != SQLITE_OK)", + newline, + box [string "uw_error(ctx, FATAL, \"Can't enable foreign_keys for SQLite database\");", + newline], + newline, string "if (uw_database_max < SIZE_MAX) {", newline, box [string "char buf[100];", @@ -843,7 +848,7 @@ val () = addDbms {name = "sqlite", textKeysNeedLengths = false, supportsNextval = false, supportsNestedPrepared = false, - sqlPrefix = "", + sqlPrefix = "PRAGMA foreign_keys = ON;\nPRAGMA journal_mode = WAL;\n\n", supportsOctetLength = false, trueString = "1", falseString = "0", -- cgit v1.2.3 From de2d8358dda08bfaf491d815df91d0c1ba33e7c9 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Tue, 13 Mar 2018 15:30:11 -0400 Subject: Handle empty SELECT clauses --- src/monoize.sml | 27 +++++++++++++++------------ src/postgres.sml | 11 +++++++++-- 2 files changed, 24 insertions(+), 14 deletions(-) diff --git a/src/monoize.sml b/src/monoize.sml index 60ff78ea..85a66e87 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -1792,18 +1792,21 @@ fun monoExp (env, st, fm) (all as (e, loc)) = NONE), loc), str "")], {disc = b, result = s}), loc), - strcatComma (map (fn (x, t) => - strcat [ - (L'.EField (gf "SelectExps", x), loc), - str (" AS " ^ Settings.mangleSql x) - ]) sexps - @ map (fn (x, xts) => - strcatComma - (map (fn (x', _) => - str ("T_" ^ x - ^ "." - ^ Settings.mangleSql x')) - xts)) stables), + if List.null sexps andalso List.all (List.null o #2) stables then + str "0" + else + strcatComma (map (fn (x, t) => + strcat [ + (L'.EField (gf "SelectExps", x), loc), + str (" AS " ^ Settings.mangleSql x) + ]) sexps + @ map (fn (x, xts) => + strcatComma + (map (fn (x', _) => + str ("T_" ^ x + ^ "." + ^ Settings.mangleSql x')) + xts)) stables), (L'.ECase (gf "From", [((L'.PPrim (Prim.String (Prim.Normal, "")), loc), str ""), diff --git a/src/postgres.sml b/src/postgres.sml index 404384d2..fac913f0 100644 --- a/src/postgres.sml +++ b/src/postgres.sml @@ -612,6 +612,13 @@ fun p_getcol {loc, wontLeakStrings, col = i, typ = t} = getter t end +(* We turn 0-output queries into 1-output queries to satisfy SQL. + * This function adjusts our length expectations. *) +fun bumpedLength ls = + case ls of + [] => 1 + | _ => length ls + fun queryCommon {loc, query, cols, doCols} = box [string "int n, i;", newline, @@ -658,7 +665,7 @@ fun queryCommon {loc, query, cols, doCols} = newline, string "if (PQnfields(res) != ", - string (Int.toString (length cols)), + string (Int.toString (bumpedLength cols)), string ") {", newline, box [string "int nf = PQnfields(res);", @@ -668,7 +675,7 @@ fun queryCommon {loc, query, cols, doCols} = string "uw_error(ctx, FATAL, \"", string (ErrorMsg.spanToString loc), string ": Query returned %d columns instead of ", - string (Int.toString (length cols)), + string (Int.toString (bumpedLength cols)), string ":\\n%s\\n%s\", nf, ", query, string ", PQerrorMessage(conn));", -- cgit v1.2.3 From 7d4a7a7f92095edfea1cb55a11e037667c2c21da Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Fri, 30 Mar 2018 18:01:44 -0400 Subject: Demo links escape frames --- demo/more/prose | 4 ++-- demo/prose | 12 ++++++------ 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/demo/more/prose b/demo/more/prose index 9c267ca0..1f1d5a49 100644 --- a/demo/more/prose +++ b/demo/more/prose @@ -1,8 +1,8 @@ -

These are some extra demo applications written in Ur/Web. See the main demo for a more tutorial-like progression through language and library features.

+

These are some extra demo applications written in Ur/Web. See the main demo for a more tutorial-like progression through language and library features.

dragList.urp -

This is an Ur/Web version of the "draggable lists" demo program from Links.

+

This is an Ur/Web version of the "draggable lists" demo program from Links.

grid1.urp diff --git a/demo/prose b/demo/prose index 11b4a885..ce12aba1 100644 --- a/demo/prose +++ b/demo/prose @@ -1,6 +1,6 @@ -

Ur/Web is a domain-specific language for programming web applications backed by SQL databases. It is (strongly) statically typed (like ML and Haskell) and purely functional (like Haskell). Ur is the base language, and the web-specific features of Ur/Web (mostly) come only in the form of special rules for parsing and optimization. The Ur core looks a lot like Standard ML, with a few Haskell-isms added, and kinder, gentler versions added of many features from dependently typed languages like the logic behind Coq. The type system is much more expressive than in ML and Haskell, such that well-typed web applications cannot "go wrong," not just in handling single HTTP requests, but across their entire lifetimes of interacting with HTTP clients. Beyond that, Ur is unusual in using ideas from dependent typing to enable very effective metaprogramming, or programming with explicit analysis of type structure. Many common web application components can be built by Ur/Web functions that operate on types, where it seems impossible to achieve similar code re-use in more established statically typed languages.

+

Ur/Web is a domain-specific language for programming web applications backed by SQL databases. It is (strongly) statically typed (like ML and Haskell) and purely functional (like Haskell). Ur is the base language, and the web-specific features of Ur/Web (mostly) come only in the form of special rules for parsing and optimization. The Ur core looks a lot like Standard ML, with a few Haskell-isms added, and kinder, gentler versions added of many features from dependently typed languages like the logic behind Coq. The type system is much more expressive than in ML and Haskell, such that well-typed web applications cannot "go wrong," not just in handling single HTTP requests, but across their entire lifetimes of interacting with HTTP clients. Beyond that, Ur is unusual in using ideas from dependent typing to enable very effective metaprogramming, or programming with explicit analysis of type structure. Many common web application components can be built by Ur/Web functions that operate on types, where it seems impossible to achieve similar code re-use in more established statically typed languages.

-

The page you are currently reading is a part of the demo included with the Ur/Web sources and supporting files available from GitHub. The following steps will build a local instance of the demo if you're lucky (and running a Debian-based Linux OS, which actually tend to have Ur/Web packages built in these days). If you're not lucky, you can consult the beginning of the manual for more detailed instructions.

+

The page you are currently reading is a part of the demo included with the Ur/Web sources and supporting files available from GitHub. The following steps will build a local instance of the demo if you're lucky (and running a Debian-based Linux OS, which actually tend to have Ur/Web packages built in these days). If you're not lucky, you can consult the beginning of the manual for more detailed instructions.

Install System Dependencies
@@ -26,7 +26,7 @@ sudo make install 

$ urweb -dbms sqlite -db /path_to_db.sqlite -demo /Demo -noEmacs demo

-

The -dbms sqlite flag indicates that instead of using the default database management system (PostgreSQL), we wish to use SQLite (usually unsuited for production). The -db flag allows us to specify the file-system path to our SQLite database. The -demo /Demo parameter indicates that we want to build a demo application that expects its URIs to begin with /Demo, while the -noEmacs parameter disables invocation of Emacs to syntax-highlight source files for HTML rendering. The final argument demo gives the path to a directory housing Ur/Web source files (.ur, .urp, .urs, etc.). +

The -dbms sqlite flag indicates that instead of using the default database management system (PostgreSQL), we wish to use SQLite (usually unsuited for production). The -db flag allows us to specify the file-system path to our SQLite database. The -demo /Demo parameter indicates that we want to build a demo application that expects its URIs to begin with /Demo, while the -noEmacs parameter disables invocation of Emacs to syntax-highlight source files for HTML rendering. The final argument demo gives the path to a directory housing Ur/Web source files (.ur, .urp, .urs, etc.).

@@ -88,7 +88,7 @@ hello.urp

We must, of course, begin with "Hello World."

-

The project file justs list one filename prefix, hello. This causes both hello.urs and hello.ur to be pulled into the project. .urs files are like OCaml .mli files, and .ur files are like OCaml .ml files. That is, .urs files provide interfaces, and .ur files provide implementations. .urs files may be omitted for .ur files, in which case most permissive interfaces are inferred.

+

The project file justs list one filename prefix, hello. This causes both hello.urs and hello.ur to be pulled into the project. .urs files are like OCaml .mli files, and .ur files are like OCaml .ml files. That is, .urs files provide interfaces, and .ur files provide implementations. .urs files may be omitted for .ur files, in which case most permissive interfaces are inferred.

Ur/Web features a module system very similar to those found in SML and OCaml. Like in OCaml, interface files are treated as module system signatures, and they are ascribed to structures built from implementation files. hello.urs tells us that we only export a function named main, taking no arguments and running a transaction that results in an HTML page. transaction is a monad in the spirit of the Haskell IO monad, with the intent that every operation performable in transaction can be undone. By design, Ur/Web does not provide a less constrained way of running side-effecting actions. This particular example application will employ no side effects, but the compiler requires that all pages be generated by transactions.

@@ -114,7 +114,7 @@ form.urp nested.urp -

Here is an implementation of the tiny challenge problem from this web framework comparison. Using nested function definitions, it is easy to persist state across clicks.

+

Here is an implementation of the tiny challenge problem from this web framework comparison. Using nested function definitions, it is easy to persist state across clicks.

cookie.urp @@ -207,7 +207,7 @@ view.urp cookieSec.urp -

Ur/Web guarantees that compiled applications are immune to certain kinds of cross site request forgery. For instance, a "phisher" might send many e-mails linking to a form that he has set up to look like your web site. The form is connected to your web site, where it might, say, transfer money from your bank account to the phisher's account. The phisher doesn't know your username, but, if that username is stored in a cookie, it will be sent automatically by your browser. Ur/Web automatically signs cookie values cryptographically, with the signature included as a POST parameter and not part of a cookie, to prevent such attacks.

+

Ur/Web guarantees that compiled applications are immune to certain kinds of cross site request forgery. For instance, a "phisher" might send many e-mails linking to a form that he has set up to look like your web site. The form is connected to your web site, where it might, say, transfer money from your bank account to the phisher's account. The phisher doesn't know your username, but, if that username is stored in a cookie, it will be sent automatically by your browser. Ur/Web automatically signs cookie values cryptographically, with the signature included as a POST parameter and not part of a cookie, to prevent such attacks.

This demo shows a simple mock-up of a situation where such an attack is often possible with traditional web frameworks. You can set an arbitrary username for yourself in a cookie, and you can modify the database in a way that depends on the current cookie value. Try getting the latter action to succeed without first setting your desired username in the cookie. This should be roughly as impossible as cracking the particular cryptographic hash function that is used.

-- cgit v1.2.3 From 1fef19035d2f3388e9ab0dad1889a4cad5c1ca3e Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 14 Apr 2018 14:17:31 -0400 Subject: List.existsM --- lib/ur/list.ur | 15 +++++++++++++++ lib/ur/list.urs | 2 ++ 2 files changed, 17 insertions(+) diff --git a/lib/ur/list.ur b/lib/ur/list.ur index cc533676..a7296552 100644 --- a/lib/ur/list.ur +++ b/lib/ur/list.ur @@ -204,6 +204,21 @@ fun exists [a] f = ex end +fun existsM [m] (_ : monad m) [a] f = + let + fun ex ls = + case ls of + [] => return False + | x :: ls => + b <- f x; + if b then + return True + else + ex ls + in + ex + end + fun foldlMap [a] [b] [c] f = let fun fold ls' st ls = diff --git a/lib/ur/list.urs b/lib/ur/list.urs index fd56679d..37cbe442 100644 --- a/lib/ur/list.urs +++ b/lib/ur/list.urs @@ -42,6 +42,8 @@ val filter : a ::: Type -> (a -> bool) -> t a -> t a val exists : a ::: Type -> (a -> bool) -> t a -> bool +val existsM : m ::: (Type -> Type) -> monad m -> a ::: Type -> (a -> m bool) -> t a -> m bool + val foldlM : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type -> (a -> b -> m b) -> b -> t a -> m b -- cgit v1.2.3 From 0cadb1a719bc515af2449ac966e545a6599aee4d Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 14 Apr 2018 15:15:07 -0400 Subject: List.findM --- lib/ur/list.ur | 15 +++++++++++++++ lib/ur/list.urs | 2 ++ 2 files changed, 17 insertions(+) diff --git a/lib/ur/list.ur b/lib/ur/list.ur index a7296552..95d6fbc8 100644 --- a/lib/ur/list.ur +++ b/lib/ur/list.ur @@ -255,6 +255,21 @@ fun find [a] f = find' end +fun findM [m] (_ : monad m) [a] f = + let + fun find' ls = + case ls of + [] => return None + | x :: ls => + b <- f x; + if b then + return (Some x) + else + find' ls + in + find' + end + fun search [a] [b] f = let fun search' ls = diff --git a/lib/ur/list.urs b/lib/ur/list.urs index 37cbe442..fe730152 100644 --- a/lib/ur/list.urs +++ b/lib/ur/list.urs @@ -60,6 +60,8 @@ val mem : a ::: Type -> eq a -> a -> t a -> bool val find : a ::: Type -> (a -> bool) -> t a -> option a +val findM : m ::: (Type -> Type) -> monad m -> a ::: Type -> (a -> m bool) -> t a -> m (option a) + val search : a ::: Type -> b ::: Type -> (a -> option b) -> t a -> option b val all : a ::: Type -> (a -> bool) -> t a -> bool -- cgit v1.2.3 From 2bc51bd866b52bc738f259ffe6e9fb8f6068a6b6 Mon Sep 17 00:00:00 2001 From: "majorseitan@blockfreie.org" Date: Sat, 14 Apr 2018 21:56:09 -0400 Subject: Handling of JSON escape characters 1. Handle escape sequence chars \t \n \r 2. Fail on unsupported escape characters. Instead of skipping \ on unsupported sequences it now fails. --- lib/ur/json.ur | 22 +++++++++++++++++----- tests/jsonTest.ur | 1 + 2 files changed, 18 insertions(+), 5 deletions(-) diff --git a/lib/ur/json.ur b/lib/ur/json.ur index 9288a6dd..1e3e3f39 100644 --- a/lib/ur/json.ur +++ b/lib/ur/json.ur @@ -46,10 +46,14 @@ fun escape s = let val ch = String.sub s 0 in - (if ch = #"\"" || ch = #"\\" then - "\\" ^ String.str ch - else - String.str ch) ^ esc (String.suffix s 1) + (case ch of + #"\n" => "\\n" + | #"\r" => "\\r" + | #"\t" => "\\t" + | #"\"" => "\\\"" + | #"\'" => "\\\'" + | x => String.str ch + ) ^ esc (String.suffix s 1) end in "\"" ^ esc s @@ -90,7 +94,15 @@ fun unescape s = if i+1 >= len then error JSON unescape: Bad escape sequence: {[s]} else - String.str (String.sub s (i+1)) ^ unesc (i+2) + (case String.sub s (i+1) of + #"n" => "\n" + | #"r" => "\r" + | #"t" => "\t" + | #"\"" => "\"" + | #"\'" => "\'" + | x => error JSON unescape: Bad escape char: {[x]}) + ^ + unesc (i+2) | _ => String.str ch ^ unesc (i+1) end in diff --git a/tests/jsonTest.ur b/tests/jsonTest.ur index 97898de8..1be6e7b5 100644 --- a/tests/jsonTest.ur +++ b/tests/jsonTest.ur @@ -1,6 +1,7 @@ open Json fun main () : transaction page = return + 
{[ fromJson "\"line 1\\nline 2\"" : string ]}

{[fromJson "[1, 2, 3]" : list int]}
{[toJson ("hi" :: "bye\"" :: "hehe" :: [])]} -- cgit v1.2.3 From e2552a79ed87721a81c246b9cfd053701d665f25 Mon Sep 17 00:00:00 2001 From: "majorseitan@blockfreie.org" Date: Sun, 15 Apr 2018 16:20:31 -0400 Subject: Handling of JSON escape characters 1. Handle the escape character \\ --- lib/ur/json.ur | 2 ++ tests/jsonTest.ur | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/lib/ur/json.ur b/lib/ur/json.ur index 1e3e3f39..7ebb010f 100644 --- a/lib/ur/json.ur +++ b/lib/ur/json.ur @@ -52,6 +52,7 @@ fun escape s = | #"\t" => "\\t" | #"\"" => "\\\"" | #"\'" => "\\\'" + | #"\\" => "\\\\" | x => String.str ch ) ^ esc (String.suffix s 1) end @@ -100,6 +101,7 @@ fun unescape s = | #"t" => "\t" | #"\"" => "\"" | #"\'" => "\'" + | #"\\" => "\\" | x => error JSON unescape: Bad escape char: {[x]}) ^ unesc (i+2) diff --git a/tests/jsonTest.ur b/tests/jsonTest.ur index 1be6e7b5..071cf34b 100644 --- a/tests/jsonTest.ur +++ b/tests/jsonTest.ur @@ -1,7 +1,7 @@ open Json fun main () : transaction page = return - 
{[ fromJson "\"line 1\\nline 2\"" : string ]}

+ 
{[ fromJson "\"\\\\line 1\\nline 2\"" : string ]}

{[fromJson "[1, 2, 3]" : list int]}
{[toJson ("hi" :: "bye\"" :: "hehe" :: [])]} -- cgit v1.2.3 From c293746d4c34ccb7abb8af41f7d05940aa7e4076 Mon Sep 17 00:00:00 2001 From: Artyom Shalkhakov Date: Tue, 8 May 2018 16:03:24 +0600 Subject: Adding Selenium-based checking to tests. --- .gitignore | 5 +++++ tests/DynChannel.py | 20 ++++++++++++++++++++ tests/Makefile | 17 +++++++++++++++++ tests/alert.py | 11 +++++++++++ tests/alert.ur | 2 +- tests/alert.urp | 3 --- tests/align.py | 11 +++++++++++ tests/appjs.py | 11 +++++++++++ tests/appjs.ur | 2 +- tests/ascdesc.py | 11 +++++++++++ tests/ascdesc.ur | 14 +++++++++++--- tests/ascdesc.urp | 3 +-- tests/attrMangle.py | 11 +++++++++++ tests/attrs_escape.py | 10 ++++++++++ tests/attrs_escape.ur | 10 ++++++---- tests/autocomp.py | 15 +++++++++++++++ tests/autocomp.ur | 8 ++++---- tests/base.py | 29 +++++++++++++++++++++++++++++ tests/bindpat.py | 9 +++++++++ tests/bindpat.ur | 7 +++++-- tests/driver.sh | 25 +++++++++++++++++++++++++ tests/entities.py | 14 ++++++++++++++ tests/entities.ur | 6 +++--- tests/fact.py | 10 ++++++++++ tests/filter.py | 9 +++++++++ tests/filter.ur | 17 ++++++++++++----- tests/jsonTest.py | 16 ++++++++++++++++ tests/jsonTest.ur | 4 ++-- 28 files changed, 280 insertions(+), 30 deletions(-) create mode 100644 tests/DynChannel.py create mode 100644 tests/alert.py delete mode 100644 tests/alert.urp create mode 100644 tests/align.py create mode 100644 tests/appjs.py create mode 100644 tests/ascdesc.py create mode 100644 tests/attrMangle.py create mode 100644 tests/attrs_escape.py create mode 100644 tests/autocomp.py create mode 100644 tests/base.py create mode 100644 tests/bindpat.py create mode 100755 tests/driver.sh create mode 100644 tests/entities.py create mode 100644 tests/fact.py create mode 100644 tests/filter.py create mode 100644 tests/jsonTest.py diff --git a/.gitignore b/.gitignore index b30fa842..377a9e5d 100644 --- a/.gitignore +++ b/.gitignore @@ -76,3 +76,8 @@ libtool include/urweb/config.h include/urweb/config.h.in include/urweb/stamp-h1 + +# python files +# Byte-compiled / optimized / DLL files +__pycache__/ +*.py[cod] diff --git a/tests/DynChannel.py b/tests/DynChannel.py new file mode 100644 index 00000000..7af5ea78 --- /dev/null +++ b/tests/DynChannel.py @@ -0,0 +1,20 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('DynChannel/main') + + # initial state: only Register is visible + reg = self.xpath('button') + reg.click() + # and we get two another state: either Register or Send visible + send = self.xpath('span/button') + send.click() + alert = self.driver.switch_to.alert + self.assertEqual("Got something from the channel", alert.text) + alert.accept() + # we got the message back + span = self.xpath('span/span') + self.assertEqual("blabla", span.text) diff --git a/tests/Makefile b/tests/Makefile index 5313d12d..63ae555e 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -2,3 +2,20 @@ all: test.o test.o: test.c gcc -c test.c -o test.o +### + +simple:: + ./driver.sh alert + ./driver.sh align + ./driver.sh appjs + ./driver.sh ascdesc + echo ./driver.sh attrMangle + ./driver.sh attrs_escape + echo ./driver.sh attrs + ./driver.sh autocomp + ./driver.sh bindpat + ./driver.sh DynChannel + ./driver.sh jsonTest + ./driver.sh entities + ./driver.sh fact + ./driver.sh filter diff --git a/tests/alert.py b/tests/alert.py new file mode 100644 index 00000000..4b783d50 --- /dev/null +++ b/tests/alert.py @@ -0,0 +1,11 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + el = self.xpath('a') + el.click() + alert = self.driver.switch_to.alert + self.assertEqual("You clicked it! That's some fancy shooting!", alert.text) diff --git a/tests/alert.ur b/tests/alert.ur index 3fe68d75..7a290921 100644 --- a/tests/alert.ur +++ b/tests/alert.ur @@ -1,3 +1,3 @@ fun main () : transaction page = return - Click Me! + alert "You clicked it! That's some fancy shooting!"}>Click Me! diff --git a/tests/alert.urp b/tests/alert.urp deleted file mode 100644 index 3976e9b0..00000000 --- a/tests/alert.urp +++ /dev/null @@ -1,3 +0,0 @@ -debug - -alert diff --git a/tests/align.py b/tests/align.py new file mode 100644 index 00000000..525ab4e6 --- /dev/null +++ b/tests/align.py @@ -0,0 +1,11 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + el = self.xpath('p[@align="left"]') + self.assertEqual("Left", el.text) + el = self.xpath('p[@align="right"]') + self.assertEqual("Right", el.text) diff --git a/tests/appjs.py b/tests/appjs.py new file mode 100644 index 00000000..02ac2193 --- /dev/null +++ b/tests/appjs.py @@ -0,0 +1,11 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + el = self.xpath('button') + el.click() + alert = self.driver.switch_to.alert + self.assertEqual("3", alert.text) diff --git a/tests/appjs.ur b/tests/appjs.ur index 01e9f345..403b0b4e 100644 --- a/tests/appjs.ur +++ b/tests/appjs.ur @@ -1,5 +1,5 @@ fun id n = if n = 0 then 0 else 1 + id (n - 1) fun main () : transaction page = return - +
{[v]}}/> / {[v]}}/> - +
diff --git a/tests/base.py b/tests/base.py new file mode 100644 index 00000000..b9a026f2 --- /dev/null +++ b/tests/base.py @@ -0,0 +1,29 @@ +# use pip install selenium first +# ensure you have both chome driver & chrome installed + +import unittest +from selenium import webdriver +from selenium.common.exceptions import NoSuchElementException + +class Base(unittest.TestCase): + """Include test cases on a given url""" + + def start(self, path='main'): + self.driver.get('http://localhost:8080/' + path) + def xpath(self, path): + return self.driver.find_element_by_xpath('/html/body/'+path) + def body_text(self): + return self.driver.find_element_by_xpath('/html/body').text + + def setUp(self): + """Start web driver""" + chrome_options = webdriver.ChromeOptions() + chrome_options.add_argument('--no-sandbox') + chrome_options.add_argument('--headless') + chrome_options.add_argument('--disable-gpu') + self.driver = webdriver.Chrome(options=chrome_options) + self.driver.implicitly_wait(10) + + def tearDown(self): + """Stop web driver""" + self.driver.quit() diff --git a/tests/bindpat.py b/tests/bindpat.py new file mode 100644 index 00000000..6c33f52f --- /dev/null +++ b/tests/bindpat.py @@ -0,0 +1,9 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.driver.get('http://localhost:8080/main') + el = self.driver.find_element_by_xpath('/html/body') + self.assertEqual("1, 2, hi, 2.34, 8, 9", el.text) diff --git a/tests/bindpat.ur b/tests/bindpat.ur index bca4bd41..8fd6eb39 100644 --- a/tests/bindpat.ur +++ b/tests/bindpat.ur @@ -1,6 +1,9 @@ fun main () : transaction page = (a, b) <- return (1, 2); {C = c, ...} <- return {C = "hi", D = False}; - d <- return 2.34; - {1 = e, 2 = f} <- return (8, 9); + let + val d = 2.34 + val {1 = e, 2 = f} = (8, 9) + in return {[a]}, {[b]}, {[c]}, {[d]}, {[e]}, {[f]} + end \ No newline at end of file diff --git a/tests/driver.sh b/tests/driver.sh new file mode 100755 index 00000000..cc62644b --- /dev/null +++ b/tests/driver.sh @@ -0,0 +1,25 @@ +#!/bin/bash + +if [[ $# -eq 0 ]] ; then + echo 'Supply at least one argument' + exit 1 +fi + +TESTDB=/tmp/$1.db +TESTSQL=/tmp/$1.sql +TESTPID=/tmp/$1.pid +TESTSRV=./$1.exe + +rm -f $TESTDB $TESTSQL $TESTPID $TESTSRV +../bin/urweb -debug -boot -noEmacs -dbms sqlite -db $TESTDB -sql $TESTSQL "$1" || exit 1 + +if [ -e $TESTSQL ] +then + sqlite3 $TESTDB < $TESTSQL +fi + +$TESTSRV -q -a 127.0.0.1 & +echo $! >> $TESTPID +sleep 1 +python -m unittest $1.py +kill `cat $TESTPID` diff --git a/tests/entities.py b/tests/entities.py new file mode 100644 index 00000000..d9087cbf --- /dev/null +++ b/tests/entities.py @@ -0,0 +1,14 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + p = self.xpath('p[1]') + self.assertEqual('Hello world! & so on, © me today (8 €)', p.text) + p = self.xpath('p[2]') + self.assertEqual('♠ ♣ ♥ ♦', p.text) + p = self.xpath('p[3]') + self.assertEqual('† DANGER †', p.text) + diff --git a/tests/entities.ur b/tests/entities.ur index 8b78edbc..1f45520d 100644 --- a/tests/entities.ur +++ b/tests/entities.ur @@ -1,5 +1,5 @@ fun main () : transaction page = return - Hello world! & so on, © me today (8 €)
- ♠ ♣ ♥ ♦
- † DANGER † +

Hello world! & so on, © me today (8 €)

+

♠ ♣ ♥ ♦

+

† DANGER †

 diff --git a/tests/fact.py b/tests/fact.py new file mode 100644 index 00000000..3dcd6f71 --- /dev/null +++ b/tests/fact.py @@ -0,0 +1,10 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + b = self.driver.find_element_by_xpath('/html/body') + self.assertEqual('3628800, 3628800', b.text) + diff --git a/tests/filter.py b/tests/filter.py new file mode 100644 index 00000000..f68f8f88 --- /dev/null +++ b/tests/filter.py @@ -0,0 +1,9 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('Filter/main') + tx = self.body_text() + self.assertEqual("4, 4; 44, 4.4;", tx) diff --git a/tests/filter.ur b/tests/filter.ur index efd326c3..2691a939 100644 --- a/tests/filter.ur +++ b/tests/filter.ur @@ -1,9 +1,16 @@ -fun filter [fs ::: {Type}] [ks] (t : sql_table fs ks) (p : sql_exp [T = fs] [] [] bool) - : sql_query [T = fs] [] = +fun filter [fs ::: {Type}] [ks] (t : sql_table fs ks) (p : sql_exp [T = fs] [] [] bool) = (SELECT * FROM t WHERE {p}) table t : { A : int, B : float } -fun main () = - queryX (filter t (WHERE t.A > 3)) - (fn r => {[r.T.A]}, {[r.T.B]}) +task initialize = fn () => + dml (INSERT INTO t (A, B) VALUES (1, 2.0)); + dml (INSERT INTO t (A, B) VALUES (2, 1.0)); + dml (INSERT INTO t (A, B) VALUES (3, 3.0)); + dml (INSERT INTO t (A, B) VALUES (4, 4.0)); + dml (INSERT INTO t (A, B) VALUES (44, 4.4)) + +fun main () : transaction page = + r <- queryX (filter t (WHERE t.A > 3)) + (fn r => {[r.T.A]}, {[r.T.B]}; ); + return {r} diff --git a/tests/jsonTest.py b/tests/jsonTest.py new file mode 100644 index 00000000..d9147511 --- /dev/null +++ b/tests/jsonTest.py @@ -0,0 +1,16 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + + pre = self.xpath('pre[1]') + self.assertEqual('line 1\nline 2', pre.text) + + pre = self.xpath('pre[2]') + self.assertEqual('1 :: 2 :: 3 :: []', pre.text) + + pre = self.xpath('pre[3]') + self.assertEqual('["hi","bye\\"","hehe"]', pre.text) diff --git a/tests/jsonTest.ur b/tests/jsonTest.ur index 1be6e7b5..38d0d201 100644 --- a/tests/jsonTest.ur +++ b/tests/jsonTest.ur @@ -2,6 +2,6 @@ open Json fun main () : transaction page = return 
{[ fromJson "\"line 1\\nline 2\"" : string ]}

- {[fromJson "[1, 2, 3]" : list int]}
- {[toJson ("hi" :: "bye\"" :: "hehe" :: [])]} + 
{[fromJson "[1, 2, 3]" : list int]}

+ 
{[toJson ("hi" :: "bye\"" :: "hehe" :: [])]}
 -- cgit v1.2.3 From 1078553f5a8de2a5e85dbd49058370afeefa68c7 Mon Sep 17 00:00:00 2001 From: Artyom Shalkhakov Date: Tue, 8 May 2018 17:25:29 +0600 Subject: Adding jsbspace for #121. --- tests/Makefile | 1 + tests/jsbspace.py | 11 +++++++++++ tests/jsbspace.ur | 12 ++++++++++++ 3 files changed, 24 insertions(+) create mode 100644 tests/jsbspace.py create mode 100644 tests/jsbspace.ur diff --git a/tests/Makefile b/tests/Makefile index 63ae555e..250a2ece 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -19,3 +19,4 @@ simple:: ./driver.sh entities ./driver.sh fact ./driver.sh filter + ./driver.sh jsbspace diff --git a/tests/jsbspace.py b/tests/jsbspace.py new file mode 100644 index 00000000..b29d44b9 --- /dev/null +++ b/tests/jsbspace.py @@ -0,0 +1,11 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + el = self.xpath('button') + el.click() + alert = self.driver.switch_to.alert + self.assertEqual('Some \btext', alert.text) diff --git a/tests/jsbspace.ur b/tests/jsbspace.ur new file mode 100644 index 00000000..bf4b824f --- /dev/null +++ b/tests/jsbspace.ur @@ -0,0 +1,12 @@ +fun main () : transaction page = +let + fun onclick (): transaction unit = + (* this function runs on the client *) + alert "Some \btext" +in +return + + + + +end \ No newline at end of file -- cgit v1.2.3 From 4c01511f5bf2229da7b146943444278d714ed7d6 Mon Sep 17 00:00:00 2001 From: Artyom Shalkhakov Date: Tue, 15 May 2018 21:48:15 +0600 Subject: More tests. --- tests/Makefile | 8 ++++++++ tests/aborter.py | 11 +++++++++++ tests/aborter.urp | 1 + tests/aborter2.py | 11 +++++++++++ tests/active.py | 14 ++++++++++++++ tests/activeBlock.py | 20 ++++++++++++++++++++ tests/activeBlock.ur | 2 +- tests/activeEmpty.py | 12 ++++++++++++ tests/activeFocus.py | 18 ++++++++++++++++++ tests/activeFocus.ur | 2 +- tests/agg.py | 8 ++++++++ tests/agg.ur | 20 +++++++++++++++----- tests/ahead.py | 15 +++++++++++++++ tests/babySpawn.py | 12 ++++++++++++ 14 files changed, 147 insertions(+), 7 deletions(-) create mode 100644 tests/aborter.py create mode 100644 tests/aborter2.py create mode 100644 tests/active.py create mode 100644 tests/activeBlock.py create mode 100644 tests/activeEmpty.py create mode 100644 tests/activeFocus.py create mode 100644 tests/agg.py create mode 100644 tests/ahead.py create mode 100644 tests/babySpawn.py diff --git a/tests/Makefile b/tests/Makefile index 250a2ece..ecf5557b 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -5,6 +5,13 @@ test.o: test.c ### simple:: + ./driver.sh aborter2 + ./driver.sh aborter + ./driver.sh activeBlock + ./driver.sh activeFocus + ./driver.sh active + ./driver.sh agg + ./driver.sh ahead ./driver.sh alert ./driver.sh align ./driver.sh appjs @@ -13,6 +20,7 @@ simple:: ./driver.sh attrs_escape echo ./driver.sh attrs ./driver.sh autocomp + ./driver.sh babySpawn ./driver.sh bindpat ./driver.sh DynChannel ./driver.sh jsonTest diff --git a/tests/aborter.py b/tests/aborter.py new file mode 100644 index 00000000..8379c656 --- /dev/null +++ b/tests/aborter.py @@ -0,0 +1,11 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('Aborter/main') + self.assertEqual("Fatal Error", self.driver.title) + txt = self.body_text() + self.assertEqual("Fatal error: :0:0-0:0: No way, Jose!", txt) + diff --git a/tests/aborter.urp b/tests/aborter.urp index fc1925ae..8c971440 100644 --- a/tests/aborter.urp +++ b/tests/aborter.urp @@ -1,4 +1,5 @@ database dbname=aborter sql aborter.sql +safeGet Aborter/main aborter diff --git a/tests/aborter2.py b/tests/aborter2.py new file mode 100644 index 00000000..c3f1e10e --- /dev/null +++ b/tests/aborter2.py @@ -0,0 +1,11 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('Aborter2/main') + self.assertEqual("", self.driver.title) + txt = self.body_text() + self.assertEqual("Result: 0", txt) + diff --git a/tests/active.py b/tests/active.py new file mode 100644 index 00000000..08846ac5 --- /dev/null +++ b/tests/active.py @@ -0,0 +1,14 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + b1 = self.xpath('span[1]/button') + b2 = self.xpath('span[2]/button') + for _ in range(3): + b1.click() + for _ in range(5): + b2.click() + self.assertEqual("3\n5", self.body_text()) diff --git a/tests/activeBlock.py b/tests/activeBlock.py new file mode 100644 index 00000000..d0e43fdb --- /dev/null +++ b/tests/activeBlock.py @@ -0,0 +1,20 @@ +import unittest +import base +import time + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + alert = self.driver.switch_to.alert + self.assertEqual("Error: May not 'sleep' in main thread of 'code' for ", alert.text) + alert.accept() + time.sleep(0.1) + alert = self.driver.switch_to.alert + self.assertEqual("Hi!", alert.text) + alert.accept() + button = self.xpath('span[1]/button') + button.click() + txt = self.body_text() + self.assertEqual("Hi! Click me! Success", txt) + diff --git a/tests/activeBlock.ur b/tests/activeBlock.ur index 5560edda..bced4af3 100644 --- a/tests/activeBlock.ur +++ b/tests/activeBlock.ur @@ -1,7 +1,7 @@ fun main () : transaction page = return - }/> Hi!}/> diff --git a/tests/activeEmpty.py b/tests/activeEmpty.py new file mode 100644 index 00000000..8872833a --- /dev/null +++ b/tests/activeEmpty.py @@ -0,0 +1,12 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + alert = self.driver.switch_to.alert + self.assertEqual("Howdy, neighbor!", alert.text) + alert.accept() + txt = self.body_text() + self.assertEqual("This one ain't empty.", txt) diff --git a/tests/activeFocus.py b/tests/activeFocus.py new file mode 100644 index 00000000..47b9a921 --- /dev/null +++ b/tests/activeFocus.py @@ -0,0 +1,18 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + uw0 = self.xpath('input[2]') + active = self.driver.switch_to.active_element + self.assertEqual(uw0, active) + def test_2(self): + """Test case 2""" + self.start('dynamic') + btn = self.xpath('button') + btn.click() + uw1 = self.xpath('span/input[2]') + active = self.driver.switch_to.active_element + self.assertEqual(uw1, active) diff --git a/tests/activeFocus.ur b/tests/activeFocus.ur index 94d465e9..82d2c0c9 100644 --- a/tests/activeFocus.ur +++ b/tests/activeFocus.ur @@ -14,5 +14,5 @@ fun dynamic () : transaction page = Done}/> - }/> + }>Click diff --git a/tests/agg.py b/tests/agg.py new file mode 100644 index 00000000..0b421d37 --- /dev/null +++ b/tests/agg.py @@ -0,0 +1,8 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('Agg/main') + self.assertEqual("0;1;2;\na, 50;", self.body_text()) diff --git a/tests/agg.ur b/tests/agg.ur index 19a8644b..2d8eed43 100644 --- a/tests/agg.ur +++ b/tests/agg.ur @@ -1,13 +1,23 @@ table t1 : {A : int, B : string, C : float} table t2 : {A : float, D : int, E : option string} -val q1 : sql_query [] _ _ = (SELECT COUNT( * ) FROM t1) -val q2 : sql_query [] _ _ = (SELECT AVG(t1.A) FROM t1) -val q3 : sql_query [] _ _ = (SELECT SUM(t1.C) FROM t1) -val q4 : sql_query [] _ _ = (SELECT MIN(t1.B), MAX(t1.A) FROM t1) -val q5 : sql_query [] _ _ = (SELECT SUM(t1.A) FROM t1 GROUP BY t1.B) +val q1 : sql_query [] [] _ _ = (SELECT COUNT( * ) FROM t1) +val q2 : sql_query [] [] _ _ = (SELECT AVG(t1.A) FROM t1) +val q3 : sql_query [] [] _ _ = (SELECT SUM(t1.C) FROM t1) +val q4 : sql_query [] [] _ _ = (SELECT MIN(t1.B), MAX(t1.A) FROM t1) +val q5 : sql_query [] [] _ _ = (SELECT SUM(t1.A) FROM t1 GROUP BY t1.B) val q6 = (SELECT COUNT(t2.E) FROM t2 GROUP BY t2.D) +task initialize = fn () => + dml (INSERT INTO t1 (A, B, C) VALUES (1, 'a', 1.0)); + dml (INSERT INTO t1 (A, B, C) VALUES (2, 'b', 2.0)); + dml (INSERT INTO t1 (A, B, C) VALUES (50, 'c', 99.0)); + dml (INSERT INTO t2 (A, D, E) VALUES (1.0, 1, NULL)); + dml (INSERT INTO t2 (A, D, E) VALUES (1.0, 2, {[Some "a"]})); + dml (INSERT INTO t2 (A, D, E) VALUES (1.0, 3, NULL)); + dml (INSERT INTO t2 (A, D, E) VALUES (1.0, 3, {[Some "b"]})); + dml (INSERT INTO t2 (A, D, E) VALUES (1.0, 3, {[Some "c"]})) + fun main () : transaction page = xml <- queryX q6 (fn r => {[r.1]};); xml2 <- queryX q4 (fn r => {[r.1]}, {[r.2]};); diff --git a/tests/ahead.py b/tests/ahead.py new file mode 100644 index 00000000..6e767948 --- /dev/null +++ b/tests/ahead.py @@ -0,0 +1,15 @@ +import unittest +import base +import time + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + alert = self.driver.switch_to.alert + self.assertEqual("Hi!", alert.text) + alert.accept() + time.sleep(0.1) + alert = self.driver.switch_to.alert + self.assertEqual("Bye!", alert.text) + alert.accept() diff --git a/tests/babySpawn.py b/tests/babySpawn.py new file mode 100644 index 00000000..6693e969 --- /dev/null +++ b/tests/babySpawn.py @@ -0,0 +1,12 @@ +import unittest +import base +import time + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start() + btn = self.xpath('button') + btn.click() + alert = self.driver.switch_to.alert + self.assertEqual("Hi", alert.text) -- cgit v1.2.3 From 30edae2956d346e7df7ca27fcc77432e45cea99e Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 19 May 2018 16:06:11 -0400 Subject: More defensive unurlification of enumerations (closes #117) --- src/cjr_print.sml | 5 ++++- tests/unurlify2.ur | 16 ++++++++++++++++ 2 files changed, 20 insertions(+), 1 deletion(-) create mode 100644 tests/unurlify2.ur diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 1fdb45d9..43265fb8 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -659,7 +659,10 @@ fun unurlify fromClient env (t, loc) = doEm rest, string ")"] in - doEm xncs + box [string "(request[0] == '/' ? ++request : request,", + newline, + doEm xncs, + string ")"] end | TDatatype (Option, i, xncs) => diff --git a/tests/unurlify2.ur b/tests/unurlify2.ur new file mode 100644 index 00000000..2e82928d --- /dev/null +++ b/tests/unurlify2.ur @@ -0,0 +1,16 @@ +datatype bugged = Nothing | Something of int +datatype myDt = One | Two +type myRecord = {Bugged: bugged + , MyDt : myDt} + +fun rpcTarget (t: myRecord) = return () + +val good = {Bugged = Something 4, MyDt = One} +val bad = {Bugged = Nothing, MyDt = One} + +fun main () : transaction page = return + + + + + -- cgit v1.2.3 From 3e8fc5122fed2baee3a4d27d51575f6dd5174ea8 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 20 May 2018 19:28:17 -0400 Subject: Proper error message when the body of a 'val' declaration fails to check against the type annotation --- src/elaborate.sml | 3 ++- tests/pairUnify.ur | 6 ++++++ 2 files changed, 8 insertions(+), 1 deletion(-) create mode 100644 tests/pairUnify.ur diff --git a/src/elaborate.sml b/src/elaborate.sml index 4a04d4bf..51d00bd8 100644 --- a/src/elaborate.sml +++ b/src/elaborate.sml @@ -4046,7 +4046,8 @@ and elabDecl (dAll as (d, loc), (env, denv, gs)) = | L.PAnnot (p', _) => singleVar p' | _ => NONE in - unifyCons env loc et pt; + (unifyCons env loc et pt + handle CUnify (c1, c2, env', err) => expError env (Unify (e', c1, c2, env', err))); (case exhaustive (env, et, [p'], loc) of NONE => () diff --git a/tests/pairUnify.ur b/tests/pairUnify.ur new file mode 100644 index 00000000..1c9f9759 --- /dev/null +++ b/tests/pairUnify.ur @@ -0,0 +1,6 @@ +datatype a = A +datatype b = B + +val x : a * b = (A, B) + +val y : b = x -- cgit v1.2.3 From 373cb403871c0c77f26cb76213adde3aeb278240 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Mon, 21 May 2018 18:53:38 -0400 Subject: A test for List.groupBy --- tests/listGroupBy.ur | 13 +++++++++++++ tests/listGroupBy.urp | 4 ++++ 2 files changed, 17 insertions(+) create mode 100644 tests/listGroupBy.ur create mode 100644 tests/listGroupBy.urp diff --git a/tests/listGroupBy.ur b/tests/listGroupBy.ur new file mode 100644 index 00000000..c2419ce1 --- /dev/null +++ b/tests/listGroupBy.ur @@ -0,0 +1,13 @@ +fun lister () = List.tabulateM (fn _ => n <- rand; return (n % 100)) 8 + +fun main () : transaction page = + inp <- source []; + return + + diff --git a/tests/caseMod.py b/tests/caseMod.py new file mode 100644 index 00000000..16e49a5b --- /dev/null +++ b/tests/caseMod.py @@ -0,0 +1,25 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('main') + l1 = self.xpath('li[1]/a') + l1.click() + + self.assertEqual("C A\n\nAgain!", self.body_text()) + def test_2(self): + """Test case 2""" + self.start('main') + l1 = self.xpath('li[2]/a') + l1.click() + + self.assertEqual("C B\n\nAgain!", self.body_text()) + def test_3(self): + """Test case 3""" + self.start('main') + l1 = self.xpath('li[3]/a') + l1.click() + + self.assertEqual("D\n\nAgain!", self.body_text()) diff --git a/tests/caseMod.ur b/tests/caseMod.ur index 0a870160..15a7e07a 100644 --- a/tests/caseMod.ur +++ b/tests/caseMod.ur @@ -24,15 +24,15 @@ val toString = fn x => | C B => "C B" | D => "D" -val rec page = fn x => +val rec page = fn x => return {cdata (toString x)}

Again! - + -val main : unit -> page = fn () => +val main : unit -> transaction page = fn () => return
  • C A
  • C B
  • D
    • - +     diff --git a/tests/ccheckbox.py b/tests/ccheckbox.py new file mode 100644 index 00000000..f2390368 --- /dev/null +++ b/tests/ccheckbox.py @@ -0,0 +1,15 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('main') + d = self.xpath('input') + p = self.xpath('span') + self.assertEqual("True 1", p.text) + d.click() + # the elements gets re-created from scratch + # so we must refresh our reference + p = self.xpath('span') + self.assertEqual("False 3", p.text) diff --git a/tests/ccheckbox.ur b/tests/ccheckbox.ur index 09a8ece9..d70c24a5 100644 --- a/tests/ccheckbox.ur +++ b/tests/ccheckbox.ur @@ -1,7 +1,7 @@ fun main () : transaction page = s <- source True; t <- source 1; - return + return set t 3}/> {[s]} {[t]}}/> diff --git a/tests/cdataF.py b/tests/cdataF.py new file mode 100644 index 00000000..8f43176f --- /dev/null +++ b/tests/cdataF.py @@ -0,0 +1,8 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('main') + self.assertEqual(" +val snippet = fn s =>

    {cdata s}

    - +     -val main = fn () => +val main : unit -> transaction page = fn () => return {snippet " + diff --git a/tests/cdataL.py b/tests/cdataL.py new file mode 100644 index 00000000..67ccd75e --- /dev/null +++ b/tests/cdataL.py @@ -0,0 +1,18 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('main') + l1 = self.xpath('li[1]/a') + l1.click() + + self.assertEqual(" +val subpage : string -> transaction page = fn s => return

    {cdata s}

    - +     -val main = fn () => +val main : unit -> transaction page = fn () => return
  • Door #1
  • Door #2
    • - +     diff --git a/tests/cffi.py b/tests/cffi.py new file mode 100644 index 00000000..34b31b8c --- /dev/null +++ b/tests/cffi.py @@ -0,0 +1,37 @@ +import unittest +import base + +class Suite(base.Base): + def test_1(self): + """Test case 1""" + self.start('Cffi/main') + l1 = self.xpath('form[1]/input') + l1.click() + + b1 = self.xpath('button[1]') + b1.click() # TODO: check server output somehow + + b2 = self.xpath('button[2]') + b2.click() + alert = self.driver.switch_to.alert + self.assertEqual("<>", alert.text) + alert.accept() + + b3 = self.xpath('button[3]') + b3.click() + alert = self.driver.switch_to.alert + self.assertEqual("Hi there!", alert.text) + def test_2(self): + """Test case 2""" + self.start('Cffi/main') + l1 = self.xpath('form[2]/input') + l1.click() + + self.assertEqual("All good.", self.body_text()) + def test_3(self): + """Test case 3""" + self.start('Cffi/main') + l1 = self.xpath('form[3]/input') + l1.click() + + self.assertRegex(self.body_text(), "^Fatal error: .*$") diff --git a/tests/cffi.sh b/tests/cffi.sh new file mode 100755 index 00000000..1267c3e3 --- /dev/null +++ b/tests/cffi.sh @@ -0,0 +1,6 @@ +#!/bin/bash + +CCOMP=gcc + +$CCOMP -pthread -Wimplicit -Werror -Wno-unused-value -I ..include/urweb -c "test.c" -o "test.o" -g +./driver.sh cffi diff --git a/tests/cffi.ur b/tests/cffi.ur index bcb9944c..89dc9906 100644 --- a/tests/cffi.ur +++ b/tests/cffi.ur @@ -3,9 +3,9 @@ fun printer () = Test.foo fun effect () = Test.print; return -